1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 pragma Style_Checks
(All_Checks
);
33 -- Turn off subprogram ordering, not used for this unit
35 with Atree
; use Atree
;
36 with Elists
; use Elists
;
37 with Namet
; use Namet
;
38 with Nlists
; use Nlists
;
39 with Output
; use Output
;
40 with Sinfo
; use Sinfo
;
41 with Stand
; use Stand
;
45 use Atree
.Unchecked_Access
;
46 -- This is one of the packages that is allowed direct untyped access to
47 -- the fields in a node, since it provides the next level abstraction
48 -- which incorporates appropriate checks.
50 ----------------------------------------------
51 -- Usage of Fields in Defining Entity Nodes --
52 ----------------------------------------------
54 -- Four of these fields are defined in Sinfo, since they in are the base
55 -- part of the node. The access routines for these four fields and the
56 -- corresponding set procedures are defined in Sinfo. These fields are
57 -- present in all entities. Note that Homonym is also in the base part of
58 -- the node, but has access routines that are more properly part of Einfo,
59 -- which is why they are defined here.
66 -- Remaining fields are present only in extended nodes (i.e. entities)
68 -- The following fields are present in all entities
71 -- First_Rep_Item Node6
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).
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 -- Postcondition_Proc Node8
83 -- Refinement_Constituents Elist8
84 -- Return_Applies_To Node8
85 -- First_Exit_Statement Node8
87 -- Class_Wide_Type Node9
88 -- Current_Value Node9
89 -- Part_Of_Constituents Elist9
92 -- Encapsulating_State Node10
93 -- Direct_Primitive_Operations Elist10
94 -- Discriminal_Link Node10
95 -- Float_Rep Uint10 (but returns Float_Rep_Kind)
96 -- Handler_Records List10
97 -- Normalized_Position_Max Uint10
99 -- Component_Bit_Offset Uint11
101 -- Entry_Component Node11
102 -- Enumeration_Pos Uint11
103 -- Generic_Homonym Node11
104 -- Last_Aggregate_Assignment Node11
105 -- Protected_Body_Subprogram Node11
108 -- Barrier_Function Node12
109 -- Enumeration_Rep Uint12
111 -- Next_Inlined_Subprogram Node12
113 -- Component_Clause Node13
114 -- Elaboration_Entity Node13
115 -- Extra_Accessibility Node13
119 -- First_Optional_Parameter Node14
120 -- Normalized_Position Uint14
121 -- Shadow_Entities List14
123 -- Discriminant_Number Uint15
124 -- DT_Position Uint15
125 -- DT_Entry_Count Uint15
126 -- Entry_Bodies_Array Node15
127 -- Entry_Parameters_Type Node15
128 -- Extra_Formal Node15
129 -- Lit_Indexes Node15
130 -- Related_Instance Node15
131 -- Status_Flag_Or_Transient_Decl Node15
132 -- Scale_Value Uint15
133 -- Storage_Size_Variable Node15
134 -- String_Literal_Low_Bound Node15
136 -- Access_Disp_Table Elist16
137 -- Body_References Elist16
138 -- Cloned_Subtype Node16
140 -- Entry_Formal Node16
141 -- First_Private_Entity Node16
142 -- Lit_Strings Node16
143 -- String_Literal_Length Uint16
144 -- Unset_Reference Node16
146 -- Actual_Subtype Node17
147 -- Digits_Value Uint17
148 -- Discriminal Node17
149 -- First_Entity Node17
150 -- First_Index Node17
151 -- First_Literal Node17
154 -- Non_Limited_View Node17
158 -- Corresponding_Concurrent_Type Node18
159 -- Corresponding_Protected_Entry Node18
160 -- Corresponding_Record_Type Node18
161 -- Delta_Value Ureal18
162 -- Enclosing_Scope Node18
163 -- Equivalent_Type Node18
164 -- Private_Dependents Elist18
165 -- Renamed_Entity Node18
166 -- Renamed_Object Node18
168 -- Body_Entity Node19
169 -- Corresponding_Discriminant Node19
170 -- Default_Aspect_Component_Value Node19
171 -- Default_Aspect_Value Node19
172 -- Extra_Accessibility_Of_Result Node19
173 -- Parent_Subtype Node19
174 -- Size_Check_Code Node19
175 -- Spec_Entity Node19
176 -- Underlying_Full_View Node19
178 -- Component_Type Node20
179 -- Default_Value Node20
180 -- Directly_Designated_Type Node20
181 -- Discriminant_Checking_Func Node20
182 -- Discriminant_Default_Value Node20
183 -- Last_Entity Node20
184 -- Prival_Link Node20
185 -- Register_Exception_Call Node20
186 -- Scalar_Range Node20
188 -- Accept_Address Elist21
189 -- Default_Expr_Function Node21
190 -- Discriminant_Constraint Elist21
191 -- Interface_Name Node21
192 -- Original_Array_Type Node21
193 -- Small_Value Ureal21
195 -- Associated_Storage_Pool Node22
196 -- Component_Size Uint22
197 -- Corresponding_Remote_Type Node22
198 -- Enumeration_Rep_Expr Node22
199 -- Exception_Code Uint22
200 -- Original_Record_Component Node22
201 -- Private_View Node22
202 -- Protected_Formal Node22
203 -- Scope_Depth_Value Uint22
204 -- Shared_Var_Procs_Instance Node22
206 -- CR_Discriminant Node23
207 -- Entry_Cancel_Parameter Node23
208 -- Enum_Pos_To_Rep Node23
209 -- Extra_Constrained Node23
210 -- Finalization_Master Node23
211 -- Generic_Renamings Elist23
212 -- Inner_Instances Elist23
213 -- Limited_View Node23
214 -- Packed_Array_Type Node23
215 -- Protection_Object Node23
216 -- Stored_Constraint Elist23
218 -- Related_Expression Node24
220 -- Interface_Alias Node25
221 -- Interfaces Elist25
222 -- Debug_Renaming_Link Node25
223 -- DT_Offset_To_Top_Func Node25
224 -- PPC_Wrapper Node25
225 -- Related_Array_Object Node25
226 -- Static_Predicate List25
227 -- Task_Body_Procedure Node25
229 -- Dispatch_Table_Wrappers Elist26
230 -- Last_Assignment Node26
231 -- Original_Access_Type Node26
232 -- Overridden_Operation Node26
233 -- Package_Instantiation Node26
234 -- Relative_Deadline_Variable Node26
236 -- Current_Use_Clause Node27
237 -- Related_Type Node27
238 -- Wrapped_Entity Node27
240 -- Extra_Formals Node28
242 -- Initialization_Statements Node28
243 -- Underlying_Record_View Node28
245 -- BIP_Initialization_Call Node29
246 -- Subprograms_For_Type Node29
248 -- Corresponding_Equality Node30
249 -- Static_Initialization Node30
251 -- Thunk_Entity Node31
253 -- SPARK_Pragma Node32
255 -- Linker_Section_Pragma Node33
256 -- SPARK_Aux_Pragma Node33
260 -- Import_Pragma Node35
262 ---------------------------------------------
263 -- Usage of Flags in Defining Entity Nodes --
264 ---------------------------------------------
266 -- All flags are unique, there is no overlaying, so each flag is physically
267 -- present in every entity. However, for many of the flags, it only makes
268 -- sense for them to be set true for certain subsets of entity kinds. See
269 -- the spec of Einfo for further details.
272 -- Has_Discriminants Flag5
273 -- Is_Dispatching_Operation Flag6
274 -- Is_Immediately_Visible Flag7
276 -- Is_Potentially_Use_Visible Flag9
280 -- Is_Constrained Flag12
281 -- Is_Generic_Type Flag13
282 -- Depends_On_Private Flag14
284 -- Is_Volatile Flag16
285 -- Is_Internal Flag17
286 -- Has_Delayed_Freeze Flag18
287 -- Is_Abstract_Subprogram Flag19
288 -- Is_Concurrent_Record_Type Flag20
290 -- Has_Master_Entity Flag21
291 -- Needs_No_Actuals Flag22
292 -- Has_Storage_Size_Clause Flag23
293 -- Is_Imported Flag24
294 -- Is_Limited_Record Flag25
295 -- Has_Completion Flag26
296 -- Has_Pragma_Controlled Flag27
297 -- Is_Statically_Allocated Flag28
298 -- Has_Size_Clause Flag29
301 -- Checks_May_Be_Suppressed Flag31
302 -- Kill_Elaboration_Checks Flag32
303 -- Kill_Range_Checks Flag33
304 -- Has_Independent_Components Flag34
305 -- Is_Class_Wide_Equivalent_Type Flag35
306 -- Referenced_As_LHS Flag36
307 -- Is_Known_Non_Null Flag37
308 -- Can_Never_Be_Null Flag38
309 -- Has_Default_Aspect Flag39
310 -- Body_Needed_For_SAL Flag40
312 -- Treat_As_Volatile Flag41
313 -- Is_Controlled Flag42
314 -- Has_Controlled_Component Flag43
316 -- In_Private_Part Flag45
317 -- Has_Alignment_Clause Flag46
319 -- In_Package_Body Flag48
321 -- Delay_Subprogram_Descriptors Flag50
324 -- Is_Entry_Formal Flag52
325 -- Is_Private_Descendant Flag53
326 -- Return_Present Flag54
327 -- Is_Tagged_Type Flag55
328 -- Has_Homonym Flag56
330 -- Non_Binary_Modulus Flag58
331 -- Is_Preelaborated Flag59
332 -- Is_Shared_Passive Flag60
334 -- Is_Remote_Types Flag61
335 -- Is_Remote_Call_Interface Flag62
336 -- Is_Character_Type Flag63
337 -- Is_Intrinsic_Subprogram Flag64
338 -- Has_Record_Rep_Clause Flag65
339 -- Has_Enumeration_Rep_Clause Flag66
340 -- Has_Small_Clause Flag67
341 -- Has_Component_Size_Clause Flag68
342 -- Is_Access_Constant Flag69
343 -- Is_First_Subtype Flag70
345 -- Has_Completion_In_Body Flag71
346 -- Has_Unknown_Discriminants Flag72
347 -- Is_Child_Unit Flag73
348 -- Is_CPP_Class Flag74
349 -- Has_Non_Standard_Rep Flag75
350 -- Is_Constructor Flag76
351 -- Static_Elaboration_Desired Flag77
353 -- Has_All_Calls_Remote Flag79
354 -- Is_Constr_Subt_For_U_Nominal Flag80
356 -- Is_Asynchronous Flag81
357 -- Has_Gigi_Rep_Item Flag82
358 -- Has_Machine_Radix_Clause Flag83
359 -- Machine_Radix_10 Flag84
361 -- Has_Atomic_Components Flag86
362 -- Has_Volatile_Components Flag87
363 -- Discard_Names Flag88
364 -- Is_Interrupt_Handler Flag89
365 -- Returns_By_Ref Flag90
368 -- Size_Known_At_Compile_Time Flag92
369 -- Reverse_Storage_Order Flag93
370 -- Is_Generic_Actual_Type Flag94
371 -- Uses_Sec_Stack Flag95
372 -- Warnings_Off Flag96
373 -- Is_Controlling_Formal Flag97
374 -- Has_Controlling_Result Flag98
375 -- Is_Exported Flag99
376 -- Has_Specified_Layout Flag100
378 -- Has_Nested_Block_With_Handler Flag101
380 -- Is_Completely_Hidden Flag103
381 -- Address_Taken Flag104
382 -- Suppress_Initialization Flag105
383 -- Is_Limited_Composite Flag106
384 -- Is_Private_Composite Flag107
385 -- Default_Expressions_Processed Flag108
386 -- Is_Non_Static_Subtype Flag109
387 -- Has_External_Tag_Rep_Clause Flag110
389 -- Is_Formal_Subprogram Flag111
390 -- Is_Renaming_Of_Object Flag112
392 -- Delay_Cleanups Flag114
393 -- Never_Set_In_Source Flag115
394 -- Is_Visible_Lib_Unit Flag116
395 -- Is_Unchecked_Union Flag117
396 -- Is_For_Access_Subtype Flag118
397 -- Has_Convention_Pragma Flag119
398 -- Has_Primitive_Operations Flag120
400 -- Has_Pragma_Pack Flag121
401 -- Is_Bit_Packed_Array Flag122
402 -- Has_Unchecked_Union Flag123
403 -- Is_Eliminated Flag124
404 -- C_Pass_By_Copy Flag125
405 -- Is_Instantiated Flag126
406 -- Is_Valued_Procedure Flag127
407 -- (used for Component_Alignment) Flag128
408 -- (used for Component_Alignment) Flag129
409 -- Is_Generic_Instance Flag130
411 -- No_Pool_Assigned Flag131
412 -- Is_AST_Entry Flag132
413 -- Is_VMS_Exception Flag133
414 -- Is_Optional_Parameter Flag134
415 -- Has_Aliased_Components Flag135
416 -- No_Strict_Aliasing Flag136
417 -- Is_Machine_Code_Subprogram Flag137
418 -- Is_Packed_Array_Type Flag138
419 -- Has_Biased_Representation Flag139
420 -- Has_Complex_Representation Flag140
422 -- Is_Constr_Subt_For_UN_Aliased Flag141
423 -- Has_Missing_Return Flag142
424 -- Has_Recursive_Call Flag143
425 -- Is_Unsigned_Type Flag144
426 -- Strict_Alignment Flag145
427 -- Is_Abstract_Type Flag146
428 -- Needs_Debug_Info Flag147
429 -- Suppress_Elaboration_Warnings Flag148
430 -- Is_Compilation_Unit Flag149
431 -- Has_Pragma_Elaborate_Body Flag150
433 -- Has_Private_Ancestor Flag151
434 -- Entry_Accepted Flag152
435 -- Is_Obsolescent Flag153
436 -- Has_Per_Object_Constraint Flag154
437 -- Has_Private_Declaration Flag155
438 -- Referenced Flag156
439 -- Has_Pragma_Inline Flag157
440 -- Finalize_Storage_Only Flag158
441 -- From_Limited_With Flag159
442 -- Is_Package_Body_Entity Flag160
444 -- Has_Qualified_Name Flag161
445 -- Nonzero_Is_True Flag162
446 -- Is_True_Constant Flag163
447 -- Reverse_Bit_Order Flag164
448 -- Suppress_Style_Checks Flag165
449 -- Debug_Info_Off Flag166
450 -- Sec_Stack_Needed_For_Return Flag167
451 -- Materialize_Entity Flag168
452 -- Has_Pragma_Thread_Local_Storage Flag169
453 -- Is_Known_Valid Flag170
455 -- Is_Hidden_Open_Scope Flag171
456 -- Has_Object_Size_Clause Flag172
457 -- Has_Fully_Qualified_Name Flag173
458 -- Elaboration_Entity_Required Flag174
459 -- Has_Forward_Instantiation Flag175
460 -- Is_Discrim_SO_Function Flag176
461 -- Size_Depends_On_Discriminant Flag177
462 -- Is_Null_Init_Proc Flag178
463 -- Has_Pragma_Pure_Function Flag179
464 -- Has_Pragma_Unreferenced Flag180
466 -- Has_Contiguous_Rep Flag181
467 -- Has_Xref_Entry Flag182
468 -- Must_Be_On_Byte_Boundary Flag183
469 -- Has_Stream_Size_Clause Flag184
470 -- Is_Ada_2005_Only Flag185
471 -- Is_Interface Flag186
472 -- Has_Constrained_Partial_View Flag187
473 -- Uses_Lock_Free Flag188
474 -- Is_Pure_Unit_Access_Type Flag189
475 -- Has_Specified_Stream_Input Flag190
477 -- Has_Specified_Stream_Output Flag191
478 -- Has_Specified_Stream_Read Flag192
479 -- Has_Specified_Stream_Write Flag193
480 -- Is_Local_Anonymous_Access Flag194
481 -- Is_Primitive_Wrapper Flag195
482 -- Was_Hidden Flag196
483 -- Is_Limited_Interface Flag197
484 -- Has_Pragma_Ordered Flag198
485 -- Is_Ada_2012_Only Flag199
487 -- Has_Delayed_Aspects Flag200
488 -- Has_Pragma_No_Inline Flag201
489 -- Itype_Printed Flag202
490 -- Has_Pragma_Pure Flag203
491 -- Is_Known_Null Flag204
492 -- Low_Bound_Tested Flag205
493 -- Is_Visible_Formal Flag206
494 -- Known_To_Have_Preelab_Init Flag207
495 -- Must_Have_Preelab_Init Flag208
496 -- Is_Return_Object Flag209
497 -- Elaborate_Body_Desirable Flag210
499 -- Has_Static_Discriminants Flag211
500 -- Has_Pragma_Unreferenced_Objects Flag212
501 -- Requires_Overriding Flag213
503 -- Has_Up_Level_Access Flag215
504 -- Universal_Aliasing Flag216
505 -- Suppress_Value_Tracking_On_Call Flag217
506 -- Is_Primitive Flag218
507 -- Has_Initial_Value Flag219
508 -- Has_Dispatch_Table Flag220
510 -- Has_Pragma_Preelab_Init Flag221
511 -- Used_As_Generic_Actual Flag222
512 -- Is_Descendent_Of_Address Flag223
515 -- Is_Only_Out_Parameter Flag226
516 -- Referenced_As_Out_Parameter Flag227
517 -- Has_Thunks Flag228
518 -- Can_Use_Internal_Rep Flag229
519 -- Has_Pragma_Inline_Always Flag230
521 -- Renamed_In_Spec Flag231
522 -- Has_Invariants Flag232
523 -- Has_Pragma_Unmodified Flag233
524 -- Is_Dispatch_Table_Entity Flag234
525 -- Is_Trivial_Subprogram Flag235
526 -- Warnings_Off_Used Flag236
527 -- Warnings_Off_Used_Unmodified Flag237
528 -- Warnings_Off_Used_Unreferenced Flag238
529 -- OK_To_Reorder_Components Flag239
530 -- Has_Postconditions Flag240
532 -- Optimize_Alignment_Space Flag241
533 -- Optimize_Alignment_Time Flag242
534 -- Overlays_Constant Flag243
535 -- Is_RACW_Stub_Type Flag244
536 -- Is_Private_Primitive Flag245
537 -- Is_Underlying_Record_View Flag246
538 -- OK_To_Rename Flag247
539 -- Has_Inheritable_Invariants Flag248
540 -- Is_Safe_To_Reevaluate Flag249
541 -- Has_Predicates Flag250
543 -- Has_Implicit_Dereference Flag251
544 -- Is_Processed_Transient Flag252
545 -- Has_Anonymous_Master Flag253
546 -- Is_Implementation_Defined Flag254
547 -- Is_Predicate_Function Flag255
548 -- Is_Predicate_Function_M Flag256
549 -- Is_Invariant_Procedure Flag257
550 -- Has_Dynamic_Predicate_Aspect Flag258
551 -- Has_Static_Predicate_Aspect Flag259
552 -- Has_Loop_Entry_Attributes Flag260
554 -- Has_Delayed_Rep_Aspects Flag261
555 -- May_Inherit_Delayed_Rep_Aspects Flag262
556 -- Has_Visible_Refinement Flag263
557 -- Is_Discriminant_Check_Function Flag264
558 -- SPARK_Pragma_Inherited Flag265
559 -- SPARK_Aux_Pragma_Inherited Flag266
560 -- Has_Shift_Operator Flag267
588 -- Note: Flag287-317 are defined in atree.ads/adb, but not yet in atree.h
590 -----------------------
591 -- Local subprograms --
592 -----------------------
595 (State_Id
: Entity_Id
;
596 Option_Nam
: Name_Id
) return Boolean;
597 -- Determine whether abstract state State_Id has particular option denoted
598 -- by the name Option_Nam.
604 function Float_Rep
(Id
: E
) return F
is
605 pragma Assert
(Is_Floating_Point_Type
(Id
));
607 return F
'Val (UI_To_Int
(Uint10
(Base_Type
(Id
))));
615 (State_Id
: Entity_Id
;
616 Option_Nam
: Name_Id
) return Boolean
618 Decl
: constant Node_Id
:= Parent
(State_Id
);
623 pragma Assert
(Ekind
(State_Id
) = E_Abstract_State
);
625 -- The declaration of abstract states with options appear as an
626 -- extension aggregate. If this is not the case, the option is not
629 if Nkind
(Decl
) /= N_Extension_Aggregate
then
635 Opt
:= First
(Expressions
(Decl
));
636 while Present
(Opt
) loop
638 -- Currently the only simple option allowed is External
640 if Nkind
(Opt
) = N_Identifier
641 and then Chars
(Opt
) = Name_External
642 and then Chars
(Opt
) = Option_Nam
650 -- Complex options with various specifiers
652 Opt
:= First
(Component_Associations
(Decl
));
653 while Present
(Opt
) loop
654 Opt_Nam
:= First
(Choices
(Opt
));
656 if Nkind
(Opt_Nam
) = N_Identifier
657 and then Chars
(Opt_Nam
) = Option_Nam
668 --------------------------------
669 -- Attribute Access Functions --
670 --------------------------------
672 function Abstract_States
(Id
: E
) return L
is
674 pragma Assert
(Ekind_In
(Id
, E_Generic_Package
, E_Package
));
678 function Accept_Address
(Id
: E
) return L
is
683 function Access_Disp_Table
(Id
: E
) return L
is
685 pragma Assert
(Ekind_In
(Id
, E_Record_Type
,
687 return Elist16
(Implementation_Base_Type
(Id
));
688 end Access_Disp_Table
;
690 function Actual_Subtype
(Id
: E
) return E
is
693 (Ekind_In
(Id
, E_Constant
, E_Variable
, E_Generic_In_Out_Parameter
)
694 or else Is_Formal
(Id
));
698 function Address_Taken
(Id
: E
) return B
is
703 function Alias
(Id
: E
) return E
is
706 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
710 function Alignment
(Id
: E
) return U
is
712 pragma Assert
(Is_Type
(Id
)
713 or else Is_Formal
(Id
)
714 or else Ekind_In
(Id
, E_Loop_Parameter
,
721 function Associated_Formal_Package
(Id
: E
) return E
is
723 pragma Assert
(Ekind
(Id
) = E_Package
);
725 end Associated_Formal_Package
;
727 function Associated_Node_For_Itype
(Id
: E
) return N
is
730 end Associated_Node_For_Itype
;
732 function Associated_Storage_Pool
(Id
: E
) return E
is
734 pragma Assert
(Is_Access_Type
(Id
));
735 return Node22
(Root_Type
(Id
));
736 end Associated_Storage_Pool
;
738 function Barrier_Function
(Id
: E
) return N
is
740 pragma Assert
(Is_Entry
(Id
));
742 end Barrier_Function
;
744 function Block_Node
(Id
: E
) return N
is
746 pragma Assert
(Ekind
(Id
) = E_Block
);
750 function Body_Entity
(Id
: E
) return E
is
752 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
));
756 function Body_Needed_For_SAL
(Id
: E
) return B
is
759 (Ekind
(Id
) = E_Package
760 or else Is_Subprogram
(Id
)
761 or else Is_Generic_Unit
(Id
));
763 end Body_Needed_For_SAL
;
765 function Body_References
(Id
: E
) return L
is
767 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
771 function BIP_Initialization_Call
(Id
: E
) return N
is
773 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
775 end BIP_Initialization_Call
;
777 function C_Pass_By_Copy
(Id
: E
) return B
is
779 pragma Assert
(Is_Record_Type
(Id
));
780 return Flag125
(Implementation_Base_Type
(Id
));
783 function Can_Never_Be_Null
(Id
: E
) return B
is
786 end Can_Never_Be_Null
;
788 function Checks_May_Be_Suppressed
(Id
: E
) return B
is
791 end Checks_May_Be_Suppressed
;
793 function Class_Wide_Type
(Id
: E
) return E
is
795 pragma Assert
(Is_Type
(Id
));
799 function Cloned_Subtype
(Id
: E
) return E
is
801 pragma Assert
(Ekind_In
(Id
, E_Record_Subtype
, E_Class_Wide_Subtype
));
805 function Component_Bit_Offset
(Id
: E
) return U
is
807 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
809 end Component_Bit_Offset
;
811 function Component_Clause
(Id
: E
) return N
is
813 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
815 end Component_Clause
;
817 function Component_Size
(Id
: E
) return U
is
819 pragma Assert
(Is_Array_Type
(Id
));
820 return Uint22
(Implementation_Base_Type
(Id
));
823 function Component_Type
(Id
: E
) return E
is
825 pragma Assert
(Is_Array_Type
(Id
) or else Is_String_Type
(Id
));
826 return Node20
(Implementation_Base_Type
(Id
));
829 function Corresponding_Concurrent_Type
(Id
: E
) return E
is
831 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
833 end Corresponding_Concurrent_Type
;
835 function Corresponding_Discriminant
(Id
: E
) return E
is
837 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
839 end Corresponding_Discriminant
;
841 function Corresponding_Equality
(Id
: E
) return E
is
844 (Ekind
(Id
) = E_Function
845 and then not Comes_From_Source
(Id
)
846 and then Chars
(Id
) = Name_Op_Ne
);
848 end Corresponding_Equality
;
850 function Corresponding_Protected_Entry
(Id
: E
) return E
is
852 pragma Assert
(Ekind
(Id
) = E_Subprogram_Body
);
854 end Corresponding_Protected_Entry
;
856 function Corresponding_Record_Type
(Id
: E
) return E
is
858 pragma Assert
(Is_Concurrent_Type
(Id
));
860 end Corresponding_Record_Type
;
862 function Corresponding_Remote_Type
(Id
: E
) return E
is
865 end Corresponding_Remote_Type
;
867 function Current_Use_Clause
(Id
: E
) return E
is
869 pragma Assert
(Ekind
(Id
) = E_Package
or else Is_Type
(Id
));
871 end Current_Use_Clause
;
873 function Current_Value
(Id
: E
) return N
is
875 pragma Assert
(Ekind
(Id
) in Object_Kind
);
879 function CR_Discriminant
(Id
: E
) return E
is
884 function Debug_Info_Off
(Id
: E
) return B
is
889 function Debug_Renaming_Link
(Id
: E
) return E
is
892 end Debug_Renaming_Link
;
894 function Default_Aspect_Component_Value
(Id
: E
) return N
is
896 pragma Assert
(Is_Array_Type
(Id
));
897 return Node19
(Base_Type
(Id
));
898 end Default_Aspect_Component_Value
;
900 function Default_Aspect_Value
(Id
: E
) return N
is
902 pragma Assert
(Is_Scalar_Type
(Id
));
903 return Node19
(Base_Type
(Id
));
904 end Default_Aspect_Value
;
906 function Default_Expr_Function
(Id
: E
) return E
is
908 pragma Assert
(Is_Formal
(Id
));
910 end Default_Expr_Function
;
912 function Default_Expressions_Processed
(Id
: E
) return B
is
915 end Default_Expressions_Processed
;
917 function Default_Value
(Id
: E
) return N
is
919 pragma Assert
(Is_Formal
(Id
));
923 function Delay_Cleanups
(Id
: E
) return B
is
928 function Delay_Subprogram_Descriptors
(Id
: E
) return B
is
931 end Delay_Subprogram_Descriptors
;
933 function Delta_Value
(Id
: E
) return R
is
935 pragma Assert
(Is_Fixed_Point_Type
(Id
));
939 function Dependent_Instances
(Id
: E
) return L
is
941 pragma Assert
(Is_Generic_Instance
(Id
));
943 end Dependent_Instances
;
945 function Depends_On_Private
(Id
: E
) return B
is
947 pragma Assert
(Nkind
(Id
) in N_Entity
);
949 end Depends_On_Private
;
951 function Digits_Value
(Id
: E
) return U
is
954 (Is_Floating_Point_Type
(Id
)
955 or else Is_Decimal_Fixed_Point_Type
(Id
));
959 function Direct_Primitive_Operations
(Id
: E
) return L
is
961 pragma Assert
(Is_Tagged_Type
(Id
));
963 end Direct_Primitive_Operations
;
965 function Directly_Designated_Type
(Id
: E
) return E
is
967 pragma Assert
(Is_Access_Type
(Id
));
969 end Directly_Designated_Type
;
971 function Discard_Names
(Id
: E
) return B
is
976 function Discriminal
(Id
: E
) return E
is
978 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
982 function Discriminal_Link
(Id
: E
) return N
is
985 end Discriminal_Link
;
987 function Discriminant_Checking_Func
(Id
: E
) return E
is
989 pragma Assert
(Ekind
(Id
) = E_Component
);
991 end Discriminant_Checking_Func
;
993 function Discriminant_Constraint
(Id
: E
) return L
is
995 pragma Assert
(Is_Composite_Type
(Id
) and then Has_Discriminants
(Id
));
997 end Discriminant_Constraint
;
999 function Discriminant_Default_Value
(Id
: E
) return N
is
1001 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1003 end Discriminant_Default_Value
;
1005 function Discriminant_Number
(Id
: E
) return U
is
1007 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1009 end Discriminant_Number
;
1011 function Dispatch_Table_Wrappers
(Id
: E
) return L
is
1013 pragma Assert
(Ekind_In
(Id
, E_Record_Type
,
1015 return Elist26
(Implementation_Base_Type
(Id
));
1016 end Dispatch_Table_Wrappers
;
1018 function DT_Entry_Count
(Id
: E
) return U
is
1020 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
1024 function DT_Offset_To_Top_Func
(Id
: E
) return E
is
1026 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
1028 end DT_Offset_To_Top_Func
;
1030 function DT_Position
(Id
: E
) return U
is
1032 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
)
1033 and then Present
(DTC_Entity
(Id
)));
1037 function DTC_Entity
(Id
: E
) return E
is
1039 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
1043 function Elaborate_Body_Desirable
(Id
: E
) return B
is
1045 pragma Assert
(Ekind
(Id
) = E_Package
);
1046 return Flag210
(Id
);
1047 end Elaborate_Body_Desirable
;
1049 function Elaboration_Entity
(Id
: E
) return E
is
1054 Ekind
(Id
) = E_Package
1056 Is_Generic_Unit
(Id
));
1058 end Elaboration_Entity
;
1060 function Elaboration_Entity_Required
(Id
: E
) return B
is
1065 Ekind
(Id
) = E_Package
1067 Is_Generic_Unit
(Id
));
1068 return Flag174
(Id
);
1069 end Elaboration_Entity_Required
;
1071 function Encapsulating_State
(Id
: E
) return N
is
1073 pragma Assert
(Ekind_In
(Id
, E_Abstract_State
, E_Variable
));
1075 end Encapsulating_State
;
1077 function Enclosing_Scope
(Id
: E
) return E
is
1080 end Enclosing_Scope
;
1082 function Entry_Accepted
(Id
: E
) return B
is
1084 pragma Assert
(Is_Entry
(Id
));
1085 return Flag152
(Id
);
1088 function Entry_Bodies_Array
(Id
: E
) return E
is
1091 end Entry_Bodies_Array
;
1093 function Entry_Cancel_Parameter
(Id
: E
) return E
is
1096 end Entry_Cancel_Parameter
;
1098 function Entry_Component
(Id
: E
) return E
is
1101 end Entry_Component
;
1103 function Entry_Formal
(Id
: E
) return E
is
1108 function Entry_Index_Constant
(Id
: E
) return N
is
1110 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
1112 end Entry_Index_Constant
;
1114 function Contract
(Id
: E
) return N
is
1117 (Ekind_In
(Id
, E_Entry
,
1124 or else Is_Generic_Subprogram
(Id
)
1125 or else Is_Subprogram
(Id
));
1129 function Entry_Parameters_Type
(Id
: E
) return E
is
1132 end Entry_Parameters_Type
;
1134 function Enum_Pos_To_Rep
(Id
: E
) return E
is
1136 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
1138 end Enum_Pos_To_Rep
;
1140 function Enumeration_Pos
(Id
: E
) return Uint
is
1142 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
1144 end Enumeration_Pos
;
1146 function Enumeration_Rep
(Id
: E
) return U
is
1148 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
1150 end Enumeration_Rep
;
1152 function Enumeration_Rep_Expr
(Id
: E
) return N
is
1154 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
1156 end Enumeration_Rep_Expr
;
1158 function Equivalent_Type
(Id
: E
) return E
is
1161 (Ekind_In
(Id
, E_Class_Wide_Type
,
1162 E_Class_Wide_Subtype
,
1163 E_Access_Subprogram_Type
,
1164 E_Access_Protected_Subprogram_Type
,
1165 E_Anonymous_Access_Protected_Subprogram_Type
,
1166 E_Access_Subprogram_Type
,
1169 end Equivalent_Type
;
1171 function Esize
(Id
: E
) return Uint
is
1176 function Exception_Code
(Id
: E
) return Uint
is
1178 pragma Assert
(Ekind
(Id
) = E_Exception
);
1182 function Extra_Accessibility
(Id
: E
) return E
is
1185 (Is_Formal
(Id
) or else Ekind_In
(Id
, E_Variable
, E_Constant
));
1187 end Extra_Accessibility
;
1189 function Extra_Accessibility_Of_Result
(Id
: E
) return E
is
1191 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Operator
, E_Subprogram_Type
));
1193 end Extra_Accessibility_Of_Result
;
1195 function Extra_Constrained
(Id
: E
) return E
is
1197 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
1199 end Extra_Constrained
;
1201 function Extra_Formal
(Id
: E
) return E
is
1206 function Extra_Formals
(Id
: E
) return E
is
1209 (Is_Overloadable
(Id
)
1210 or else Ekind_In
(Id
, E_Entry_Family
,
1212 E_Subprogram_Type
));
1216 function Can_Use_Internal_Rep
(Id
: E
) return B
is
1218 pragma Assert
(Is_Access_Subprogram_Type
(Base_Type
(Id
)));
1219 return Flag229
(Base_Type
(Id
));
1220 end Can_Use_Internal_Rep
;
1222 function Finalization_Master
(Id
: E
) return E
is
1224 pragma Assert
(Is_Access_Type
(Id
));
1225 return Node23
(Root_Type
(Id
));
1226 end Finalization_Master
;
1228 function Finalize_Storage_Only
(Id
: E
) return B
is
1230 pragma Assert
(Is_Type
(Id
));
1231 return Flag158
(Base_Type
(Id
));
1232 end Finalize_Storage_Only
;
1234 function Finalizer
(Id
: E
) return E
is
1236 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Package_Body
));
1240 function First_Entity
(Id
: E
) return E
is
1245 function First_Exit_Statement
(Id
: E
) return N
is
1247 pragma Assert
(Ekind
(Id
) = E_Loop
);
1249 end First_Exit_Statement
;
1251 function First_Index
(Id
: E
) return N
is
1253 pragma Assert
(Is_Array_Type
(Id
) or else Is_String_Type
(Id
));
1257 function First_Literal
(Id
: E
) return E
is
1259 pragma Assert
(Is_Enumeration_Type
(Id
));
1263 function First_Optional_Parameter
(Id
: E
) return E
is
1265 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
1267 end First_Optional_Parameter
;
1269 function First_Private_Entity
(Id
: E
) return E
is
1271 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
)
1272 or else Ekind
(Id
) in Concurrent_Kind
);
1274 end First_Private_Entity
;
1276 function First_Rep_Item
(Id
: E
) return E
is
1281 function Freeze_Node
(Id
: E
) return N
is
1286 function From_Limited_With
(Id
: E
) return B
is
1288 return Flag159
(Id
);
1289 end From_Limited_With
;
1291 function Full_View
(Id
: E
) return E
is
1293 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
1297 function Generic_Homonym
(Id
: E
) return E
is
1299 pragma Assert
(Ekind
(Id
) = E_Generic_Package
);
1301 end Generic_Homonym
;
1303 function Generic_Renamings
(Id
: E
) return L
is
1305 return Elist23
(Id
);
1306 end Generic_Renamings
;
1308 function Handler_Records
(Id
: E
) return S
is
1311 end Handler_Records
;
1313 function Has_Aliased_Components
(Id
: E
) return B
is
1315 return Flag135
(Implementation_Base_Type
(Id
));
1316 end Has_Aliased_Components
;
1318 function Has_Alignment_Clause
(Id
: E
) return B
is
1321 end Has_Alignment_Clause
;
1323 function Has_All_Calls_Remote
(Id
: E
) return B
is
1326 end Has_All_Calls_Remote
;
1328 function Has_Anonymous_Master
(Id
: E
) return B
is
1331 (Ekind_In
(Id
, E_Function
, E_Package
, E_Package_Body
, E_Procedure
));
1332 return Flag253
(Id
);
1333 end Has_Anonymous_Master
;
1335 function Has_Atomic_Components
(Id
: E
) return B
is
1337 return Flag86
(Implementation_Base_Type
(Id
));
1338 end Has_Atomic_Components
;
1340 function Has_Biased_Representation
(Id
: E
) return B
is
1342 return Flag139
(Id
);
1343 end Has_Biased_Representation
;
1345 function Has_Completion
(Id
: E
) return B
is
1350 function Has_Completion_In_Body
(Id
: E
) return B
is
1352 pragma Assert
(Is_Type
(Id
));
1354 end Has_Completion_In_Body
;
1356 function Has_Complex_Representation
(Id
: E
) return B
is
1358 pragma Assert
(Is_Type
(Id
));
1359 return Flag140
(Implementation_Base_Type
(Id
));
1360 end Has_Complex_Representation
;
1362 function Has_Component_Size_Clause
(Id
: E
) return B
is
1364 pragma Assert
(Is_Array_Type
(Id
));
1365 return Flag68
(Implementation_Base_Type
(Id
));
1366 end Has_Component_Size_Clause
;
1368 function Has_Constrained_Partial_View
(Id
: E
) return B
is
1370 pragma Assert
(Is_Type
(Id
));
1371 return Flag187
(Id
);
1372 end Has_Constrained_Partial_View
;
1374 function Has_Controlled_Component
(Id
: E
) return B
is
1376 return Flag43
(Base_Type
(Id
));
1377 end Has_Controlled_Component
;
1379 function Has_Contiguous_Rep
(Id
: E
) return B
is
1381 return Flag181
(Id
);
1382 end Has_Contiguous_Rep
;
1384 function Has_Controlling_Result
(Id
: E
) return B
is
1387 end Has_Controlling_Result
;
1389 function Has_Convention_Pragma
(Id
: E
) return B
is
1391 return Flag119
(Id
);
1392 end Has_Convention_Pragma
;
1394 function Has_Default_Aspect
(Id
: E
) return B
is
1396 return Flag39
(Base_Type
(Id
));
1397 end Has_Default_Aspect
;
1399 function Has_Delayed_Aspects
(Id
: E
) return B
is
1401 pragma Assert
(Nkind
(Id
) in N_Entity
);
1402 return Flag200
(Id
);
1403 end Has_Delayed_Aspects
;
1405 function Has_Delayed_Freeze
(Id
: E
) return B
is
1407 pragma Assert
(Nkind
(Id
) in N_Entity
);
1409 end Has_Delayed_Freeze
;
1411 function Has_Delayed_Rep_Aspects
(Id
: E
) return B
is
1413 pragma Assert
(Nkind
(Id
) in N_Entity
);
1414 return Flag261
(Id
);
1415 end Has_Delayed_Rep_Aspects
;
1417 function Has_Discriminants
(Id
: E
) return B
is
1419 pragma Assert
(Nkind
(Id
) in N_Entity
);
1421 end Has_Discriminants
;
1423 function Has_Dispatch_Table
(Id
: E
) return B
is
1425 pragma Assert
(Is_Tagged_Type
(Id
));
1426 return Flag220
(Id
);
1427 end Has_Dispatch_Table
;
1429 function Has_Dynamic_Predicate_Aspect
(Id
: E
) return B
is
1431 pragma Assert
(Is_Type
(Id
));
1432 return Flag258
(Id
);
1433 end Has_Dynamic_Predicate_Aspect
;
1435 function Has_Enumeration_Rep_Clause
(Id
: E
) return B
is
1437 pragma Assert
(Is_Enumeration_Type
(Id
));
1439 end Has_Enumeration_Rep_Clause
;
1441 function Has_Exit
(Id
: E
) return B
is
1446 function Has_External_Tag_Rep_Clause
(Id
: E
) return B
is
1448 pragma Assert
(Is_Tagged_Type
(Id
));
1449 return Flag110
(Id
);
1450 end Has_External_Tag_Rep_Clause
;
1452 function Has_Forward_Instantiation
(Id
: E
) return B
is
1454 return Flag175
(Id
);
1455 end Has_Forward_Instantiation
;
1457 function Has_Fully_Qualified_Name
(Id
: E
) return B
is
1459 return Flag173
(Id
);
1460 end Has_Fully_Qualified_Name
;
1462 function Has_Gigi_Rep_Item
(Id
: E
) return B
is
1465 end Has_Gigi_Rep_Item
;
1467 function Has_Homonym
(Id
: E
) return B
is
1472 function Has_Implicit_Dereference
(Id
: E
) return B
is
1474 return Flag251
(Id
);
1475 end Has_Implicit_Dereference
;
1477 function Has_Independent_Components
(Id
: E
) return B
is
1479 pragma Assert
(Is_Object
(Id
) or else Is_Type
(Id
));
1481 end Has_Independent_Components
;
1483 function Has_Inheritable_Invariants
(Id
: E
) return B
is
1485 pragma Assert
(Is_Type
(Id
));
1486 return Flag248
(Id
);
1487 end Has_Inheritable_Invariants
;
1489 function Has_Initial_Value
(Id
: E
) return B
is
1491 pragma Assert
(Ekind
(Id
) = E_Variable
or else Is_Formal
(Id
));
1492 return Flag219
(Id
);
1493 end Has_Initial_Value
;
1495 function Has_Invariants
(Id
: E
) return B
is
1497 pragma Assert
(Is_Type
(Id
));
1498 return Flag232
(Id
);
1501 function Has_Loop_Entry_Attributes
(Id
: E
) return B
is
1503 pragma Assert
(Ekind
(Id
) = E_Loop
);
1504 return Flag260
(Id
);
1505 end Has_Loop_Entry_Attributes
;
1507 function Has_Machine_Radix_Clause
(Id
: E
) return B
is
1509 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
1511 end Has_Machine_Radix_Clause
;
1513 function Has_Master_Entity
(Id
: E
) return B
is
1516 end Has_Master_Entity
;
1518 function Has_Missing_Return
(Id
: E
) return B
is
1520 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Generic_Function
));
1521 return Flag142
(Id
);
1522 end Has_Missing_Return
;
1524 function Has_Nested_Block_With_Handler
(Id
: E
) return B
is
1526 return Flag101
(Id
);
1527 end Has_Nested_Block_With_Handler
;
1529 function Has_Non_Standard_Rep
(Id
: E
) return B
is
1531 return Flag75
(Implementation_Base_Type
(Id
));
1532 end Has_Non_Standard_Rep
;
1534 function Has_Object_Size_Clause
(Id
: E
) return B
is
1536 pragma Assert
(Is_Type
(Id
));
1537 return Flag172
(Id
);
1538 end Has_Object_Size_Clause
;
1540 function Has_Per_Object_Constraint
(Id
: E
) return B
is
1542 return Flag154
(Id
);
1543 end Has_Per_Object_Constraint
;
1545 function Has_Postconditions
(Id
: E
) return B
is
1547 pragma Assert
(Is_Subprogram
(Id
));
1548 return Flag240
(Id
);
1549 end Has_Postconditions
;
1551 function Has_Pragma_Controlled
(Id
: E
) return B
is
1553 pragma Assert
(Is_Access_Type
(Id
));
1554 return Flag27
(Implementation_Base_Type
(Id
));
1555 end Has_Pragma_Controlled
;
1557 function Has_Pragma_Elaborate_Body
(Id
: E
) return B
is
1559 return Flag150
(Id
);
1560 end Has_Pragma_Elaborate_Body
;
1562 function Has_Pragma_Inline
(Id
: E
) return B
is
1564 return Flag157
(Id
);
1565 end Has_Pragma_Inline
;
1567 function Has_Pragma_Inline_Always
(Id
: E
) return B
is
1569 return Flag230
(Id
);
1570 end Has_Pragma_Inline_Always
;
1572 function Has_Pragma_No_Inline
(Id
: E
) return B
is
1574 return Flag201
(Id
);
1575 end Has_Pragma_No_Inline
;
1577 function Has_Pragma_Ordered
(Id
: E
) return B
is
1579 pragma Assert
(Is_Enumeration_Type
(Id
));
1580 return Flag198
(Implementation_Base_Type
(Id
));
1581 end Has_Pragma_Ordered
;
1583 function Has_Pragma_Pack
(Id
: E
) return B
is
1585 pragma Assert
(Is_Record_Type
(Id
) or else Is_Array_Type
(Id
));
1586 return Flag121
(Implementation_Base_Type
(Id
));
1587 end Has_Pragma_Pack
;
1589 function Has_Pragma_Preelab_Init
(Id
: E
) return B
is
1591 return Flag221
(Id
);
1592 end Has_Pragma_Preelab_Init
;
1594 function Has_Pragma_Pure
(Id
: E
) return B
is
1596 return Flag203
(Id
);
1597 end Has_Pragma_Pure
;
1599 function Has_Pragma_Pure_Function
(Id
: E
) return B
is
1601 return Flag179
(Id
);
1602 end Has_Pragma_Pure_Function
;
1604 function Has_Pragma_Thread_Local_Storage
(Id
: E
) return B
is
1606 return Flag169
(Id
);
1607 end Has_Pragma_Thread_Local_Storage
;
1609 function Has_Pragma_Unmodified
(Id
: E
) return B
is
1611 return Flag233
(Id
);
1612 end Has_Pragma_Unmodified
;
1614 function Has_Pragma_Unreferenced
(Id
: E
) return B
is
1616 return Flag180
(Id
);
1617 end Has_Pragma_Unreferenced
;
1619 function Has_Pragma_Unreferenced_Objects
(Id
: E
) return B
is
1621 pragma Assert
(Is_Type
(Id
));
1622 return Flag212
(Id
);
1623 end Has_Pragma_Unreferenced_Objects
;
1625 function Has_Predicates
(Id
: E
) return B
is
1627 pragma Assert
(Is_Type
(Id
));
1628 return Flag250
(Id
);
1631 function Has_Primitive_Operations
(Id
: E
) return B
is
1633 pragma Assert
(Is_Type
(Id
));
1634 return Flag120
(Base_Type
(Id
));
1635 end Has_Primitive_Operations
;
1637 function Has_Private_Ancestor
(Id
: E
) return B
is
1639 return Flag151
(Id
);
1640 end Has_Private_Ancestor
;
1642 function Has_Private_Declaration
(Id
: E
) return B
is
1644 return Flag155
(Id
);
1645 end Has_Private_Declaration
;
1647 function Has_Qualified_Name
(Id
: E
) return B
is
1649 return Flag161
(Id
);
1650 end Has_Qualified_Name
;
1652 function Has_RACW
(Id
: E
) return B
is
1654 pragma Assert
(Ekind
(Id
) = E_Package
);
1655 return Flag214
(Id
);
1658 function Has_Record_Rep_Clause
(Id
: E
) return B
is
1660 pragma Assert
(Is_Record_Type
(Id
));
1661 return Flag65
(Implementation_Base_Type
(Id
));
1662 end Has_Record_Rep_Clause
;
1664 function Has_Recursive_Call
(Id
: E
) return B
is
1666 pragma Assert
(Is_Subprogram
(Id
));
1667 return Flag143
(Id
);
1668 end Has_Recursive_Call
;
1670 function Has_Shift_Operator
(Id
: E
) return B
is
1672 pragma Assert
(Is_Integer_Type
(Id
));
1673 return Flag267
(Base_Type
(Id
));
1674 end Has_Shift_Operator
;
1676 function Has_Size_Clause
(Id
: E
) return B
is
1679 end Has_Size_Clause
;
1681 function Has_Small_Clause
(Id
: E
) return B
is
1684 end Has_Small_Clause
;
1686 function Has_Specified_Layout
(Id
: E
) return B
is
1688 pragma Assert
(Is_Type
(Id
));
1689 return Flag100
(Implementation_Base_Type
(Id
));
1690 end Has_Specified_Layout
;
1692 function Has_Specified_Stream_Input
(Id
: E
) return B
is
1694 pragma Assert
(Is_Type
(Id
));
1695 return Flag190
(Id
);
1696 end Has_Specified_Stream_Input
;
1698 function Has_Specified_Stream_Output
(Id
: E
) return B
is
1700 pragma Assert
(Is_Type
(Id
));
1701 return Flag191
(Id
);
1702 end Has_Specified_Stream_Output
;
1704 function Has_Specified_Stream_Read
(Id
: E
) return B
is
1706 pragma Assert
(Is_Type
(Id
));
1707 return Flag192
(Id
);
1708 end Has_Specified_Stream_Read
;
1710 function Has_Specified_Stream_Write
(Id
: E
) return B
is
1712 pragma Assert
(Is_Type
(Id
));
1713 return Flag193
(Id
);
1714 end Has_Specified_Stream_Write
;
1716 function Has_Static_Discriminants
(Id
: E
) return B
is
1718 pragma Assert
(Is_Type
(Id
));
1719 return Flag211
(Id
);
1720 end Has_Static_Discriminants
;
1722 function Has_Static_Predicate_Aspect
(Id
: E
) return B
is
1724 pragma Assert
(Is_Type
(Id
));
1725 return Flag259
(Id
);
1726 end Has_Static_Predicate_Aspect
;
1728 function Has_Storage_Size_Clause
(Id
: E
) return B
is
1730 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
1731 return Flag23
(Implementation_Base_Type
(Id
));
1732 end Has_Storage_Size_Clause
;
1734 function Has_Stream_Size_Clause
(Id
: E
) return B
is
1736 return Flag184
(Id
);
1737 end Has_Stream_Size_Clause
;
1739 function Has_Task
(Id
: E
) return B
is
1741 return Flag30
(Base_Type
(Id
));
1744 function Has_Thunks
(Id
: E
) return B
is
1746 return Flag228
(Id
);
1749 function Has_Unchecked_Union
(Id
: E
) return B
is
1751 return Flag123
(Base_Type
(Id
));
1752 end Has_Unchecked_Union
;
1754 function Has_Unknown_Discriminants
(Id
: E
) return B
is
1756 pragma Assert
(Is_Type
(Id
));
1758 end Has_Unknown_Discriminants
;
1760 function Has_Up_Level_Access
(Id
: E
) return B
is
1763 (Ekind_In
(Id
, E_Variable
, E_Constant
, E_Loop_Parameter
));
1764 return Flag215
(Id
);
1765 end Has_Up_Level_Access
;
1767 function Has_Visible_Refinement
(Id
: E
) return B
is
1769 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
1770 return Flag263
(Id
);
1771 end Has_Visible_Refinement
;
1773 function Has_Volatile_Components
(Id
: E
) return B
is
1775 return Flag87
(Implementation_Base_Type
(Id
));
1776 end Has_Volatile_Components
;
1778 function Has_Xref_Entry
(Id
: E
) return B
is
1780 return Flag182
(Id
);
1783 function Hiding_Loop_Variable
(Id
: E
) return E
is
1785 pragma Assert
(Ekind
(Id
) = E_Variable
);
1787 end Hiding_Loop_Variable
;
1789 function Homonym
(Id
: E
) return E
is
1794 function Import_Pragma
(Id
: E
) return E
is
1796 pragma Assert
(Is_Subprogram
(Id
));
1800 function Interface_Alias
(Id
: E
) return E
is
1802 pragma Assert
(Is_Subprogram
(Id
));
1804 end Interface_Alias
;
1806 function Interfaces
(Id
: E
) return L
is
1808 pragma Assert
(Is_Record_Type
(Id
));
1809 return Elist25
(Id
);
1812 function In_Package_Body
(Id
: E
) return B
is
1815 end In_Package_Body
;
1817 function In_Private_Part
(Id
: E
) return B
is
1820 end In_Private_Part
;
1822 function In_Use
(Id
: E
) return B
is
1824 pragma Assert
(Nkind
(Id
) in N_Entity
);
1828 function Initialization_Statements
(Id
: E
) return N
is
1830 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
1832 end Initialization_Statements
;
1834 function Inner_Instances
(Id
: E
) return L
is
1836 return Elist23
(Id
);
1837 end Inner_Instances
;
1839 function Interface_Name
(Id
: E
) return N
is
1844 function Is_Abstract_Subprogram
(Id
: E
) return B
is
1846 pragma Assert
(Is_Overloadable
(Id
));
1848 end Is_Abstract_Subprogram
;
1850 function Is_Abstract_Type
(Id
: E
) return B
is
1852 pragma Assert
(Is_Type
(Id
));
1853 return Flag146
(Id
);
1854 end Is_Abstract_Type
;
1856 function Is_Local_Anonymous_Access
(Id
: E
) return B
is
1858 pragma Assert
(Is_Access_Type
(Id
));
1859 return Flag194
(Id
);
1860 end Is_Local_Anonymous_Access
;
1862 function Is_Access_Constant
(Id
: E
) return B
is
1864 pragma Assert
(Is_Access_Type
(Id
));
1866 end Is_Access_Constant
;
1868 function Is_Ada_2005_Only
(Id
: E
) return B
is
1870 return Flag185
(Id
);
1871 end Is_Ada_2005_Only
;
1873 function Is_Ada_2012_Only
(Id
: E
) return B
is
1875 return Flag199
(Id
);
1876 end Is_Ada_2012_Only
;
1878 function Is_Aliased
(Id
: E
) return B
is
1880 pragma Assert
(Nkind
(Id
) in N_Entity
);
1884 function Is_AST_Entry
(Id
: E
) return B
is
1886 pragma Assert
(Is_Entry
(Id
));
1887 return Flag132
(Id
);
1890 function Is_Asynchronous
(Id
: E
) return B
is
1892 pragma Assert
(Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
1894 end Is_Asynchronous
;
1896 function Is_Atomic
(Id
: E
) return B
is
1901 function Is_Bit_Packed_Array
(Id
: E
) return B
is
1903 return Flag122
(Implementation_Base_Type
(Id
));
1904 end Is_Bit_Packed_Array
;
1906 function Is_Called
(Id
: E
) return B
is
1908 pragma Assert
(Ekind_In
(Id
, E_Procedure
, E_Function
));
1909 return Flag102
(Id
);
1912 function Is_Character_Type
(Id
: E
) return B
is
1915 end Is_Character_Type
;
1917 function Is_Child_Unit
(Id
: E
) return B
is
1922 function Is_Class_Wide_Equivalent_Type
(Id
: E
) return B
is
1925 end Is_Class_Wide_Equivalent_Type
;
1927 function Is_Compilation_Unit
(Id
: E
) return B
is
1929 return Flag149
(Id
);
1930 end Is_Compilation_Unit
;
1932 function Is_Completely_Hidden
(Id
: E
) return B
is
1934 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
1935 return Flag103
(Id
);
1936 end Is_Completely_Hidden
;
1938 function Is_Constr_Subt_For_U_Nominal
(Id
: E
) return B
is
1941 end Is_Constr_Subt_For_U_Nominal
;
1943 function Is_Constr_Subt_For_UN_Aliased
(Id
: E
) return B
is
1945 return Flag141
(Id
);
1946 end Is_Constr_Subt_For_UN_Aliased
;
1948 function Is_Constrained
(Id
: E
) return B
is
1950 pragma Assert
(Nkind
(Id
) in N_Entity
);
1954 function Is_Constructor
(Id
: E
) return B
is
1959 function Is_Controlled
(Id
: E
) return B
is
1961 return Flag42
(Base_Type
(Id
));
1964 function Is_Controlling_Formal
(Id
: E
) return B
is
1966 pragma Assert
(Is_Formal
(Id
));
1968 end Is_Controlling_Formal
;
1970 function Is_CPP_Class
(Id
: E
) return B
is
1975 function Is_Descendent_Of_Address
(Id
: E
) return B
is
1977 return Flag223
(Id
);
1978 end Is_Descendent_Of_Address
;
1980 function Is_Discrim_SO_Function
(Id
: E
) return B
is
1982 return Flag176
(Id
);
1983 end Is_Discrim_SO_Function
;
1985 function Is_Discriminant_Check_Function
(Id
: E
) return B
is
1987 return Flag264
(Id
);
1988 end Is_Discriminant_Check_Function
;
1990 function Is_Dispatch_Table_Entity
(Id
: E
) return B
is
1992 return Flag234
(Id
);
1993 end Is_Dispatch_Table_Entity
;
1995 function Is_Dispatching_Operation
(Id
: E
) return B
is
1997 pragma Assert
(Nkind
(Id
) in N_Entity
);
1999 end Is_Dispatching_Operation
;
2001 function Is_Eliminated
(Id
: E
) return B
is
2003 return Flag124
(Id
);
2006 function Is_Entry_Formal
(Id
: E
) return B
is
2009 end Is_Entry_Formal
;
2011 function Is_Exported
(Id
: E
) return B
is
2016 function Is_First_Subtype
(Id
: E
) return B
is
2019 end Is_First_Subtype
;
2021 function Is_For_Access_Subtype
(Id
: E
) return B
is
2023 pragma Assert
(Ekind_In
(Id
, E_Record_Subtype
, E_Private_Subtype
));
2024 return Flag118
(Id
);
2025 end Is_For_Access_Subtype
;
2027 function Is_Formal_Subprogram
(Id
: E
) return B
is
2029 return Flag111
(Id
);
2030 end Is_Formal_Subprogram
;
2032 function Is_Frozen
(Id
: E
) return B
is
2037 function Is_Generic_Actual_Type
(Id
: E
) return B
is
2039 pragma Assert
(Is_Type
(Id
));
2041 end Is_Generic_Actual_Type
;
2043 function Is_Generic_Instance
(Id
: E
) return B
is
2045 return Flag130
(Id
);
2046 end Is_Generic_Instance
;
2048 function Is_Generic_Type
(Id
: E
) return B
is
2050 pragma Assert
(Nkind
(Id
) in N_Entity
);
2052 end Is_Generic_Type
;
2054 function Is_Hidden
(Id
: E
) return B
is
2059 function Is_Hidden_Open_Scope
(Id
: E
) return B
is
2061 return Flag171
(Id
);
2062 end Is_Hidden_Open_Scope
;
2064 function Is_Immediately_Visible
(Id
: E
) return B
is
2066 pragma Assert
(Nkind
(Id
) in N_Entity
);
2068 end Is_Immediately_Visible
;
2070 function Is_Implementation_Defined
(Id
: E
) return B
is
2072 return Flag254
(Id
);
2073 end Is_Implementation_Defined
;
2075 function Is_Imported
(Id
: E
) return B
is
2080 function Is_Inlined
(Id
: E
) return B
is
2085 function Is_Interface
(Id
: E
) return B
is
2087 return Flag186
(Id
);
2090 function Is_Instantiated
(Id
: E
) return B
is
2092 return Flag126
(Id
);
2093 end Is_Instantiated
;
2095 function Is_Internal
(Id
: E
) return B
is
2097 pragma Assert
(Nkind
(Id
) in N_Entity
);
2101 function Is_Interrupt_Handler
(Id
: E
) return B
is
2103 pragma Assert
(Nkind
(Id
) in N_Entity
);
2105 end Is_Interrupt_Handler
;
2107 function Is_Intrinsic_Subprogram
(Id
: E
) return B
is
2110 end Is_Intrinsic_Subprogram
;
2112 function Is_Invariant_Procedure
(Id
: E
) return B
is
2114 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2115 return Flag257
(Id
);
2116 end Is_Invariant_Procedure
;
2118 function Is_Itype
(Id
: E
) return B
is
2123 function Is_Known_Non_Null
(Id
: E
) return B
is
2126 end Is_Known_Non_Null
;
2128 function Is_Known_Null
(Id
: E
) return B
is
2130 return Flag204
(Id
);
2133 function Is_Known_Valid
(Id
: E
) return B
is
2135 return Flag170
(Id
);
2138 function Is_Limited_Composite
(Id
: E
) return B
is
2140 return Flag106
(Id
);
2141 end Is_Limited_Composite
;
2143 function Is_Limited_Interface
(Id
: E
) return B
is
2145 return Flag197
(Id
);
2146 end Is_Limited_Interface
;
2148 function Is_Limited_Record
(Id
: E
) return B
is
2151 end Is_Limited_Record
;
2153 function Is_Machine_Code_Subprogram
(Id
: E
) return B
is
2155 pragma Assert
(Is_Subprogram
(Id
));
2156 return Flag137
(Id
);
2157 end Is_Machine_Code_Subprogram
;
2159 function Is_Non_Static_Subtype
(Id
: E
) return B
is
2161 pragma Assert
(Is_Type
(Id
));
2162 return Flag109
(Id
);
2163 end Is_Non_Static_Subtype
;
2165 function Is_Null_Init_Proc
(Id
: E
) return B
is
2167 pragma Assert
(Ekind
(Id
) = E_Procedure
);
2168 return Flag178
(Id
);
2169 end Is_Null_Init_Proc
;
2171 function Is_Obsolescent
(Id
: E
) return B
is
2173 return Flag153
(Id
);
2176 function Is_Only_Out_Parameter
(Id
: E
) return B
is
2178 pragma Assert
(Is_Formal
(Id
));
2179 return Flag226
(Id
);
2180 end Is_Only_Out_Parameter
;
2182 function Is_Optional_Parameter
(Id
: E
) return B
is
2184 pragma Assert
(Is_Formal
(Id
));
2185 return Flag134
(Id
);
2186 end Is_Optional_Parameter
;
2188 function Is_Package_Body_Entity
(Id
: E
) return B
is
2190 return Flag160
(Id
);
2191 end Is_Package_Body_Entity
;
2193 function Is_Packed
(Id
: E
) return B
is
2195 return Flag51
(Implementation_Base_Type
(Id
));
2198 function Is_Packed_Array_Type
(Id
: E
) return B
is
2200 return Flag138
(Id
);
2201 end Is_Packed_Array_Type
;
2203 function Is_Potentially_Use_Visible
(Id
: E
) return B
is
2205 pragma Assert
(Nkind
(Id
) in N_Entity
);
2207 end Is_Potentially_Use_Visible
;
2209 function Is_Predicate_Function
(Id
: E
) return B
is
2211 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2212 return Flag255
(Id
);
2213 end Is_Predicate_Function
;
2215 function Is_Predicate_Function_M
(Id
: E
) return B
is
2217 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
2218 return Flag256
(Id
);
2219 end Is_Predicate_Function_M
;
2221 function Is_Preelaborated
(Id
: E
) return B
is
2224 end Is_Preelaborated
;
2226 function Is_Primitive
(Id
: E
) return B
is
2229 (Is_Overloadable
(Id
)
2230 or else Ekind_In
(Id
, E_Generic_Function
, E_Generic_Procedure
));
2231 return Flag218
(Id
);
2234 function Is_Primitive_Wrapper
(Id
: E
) return B
is
2236 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
2237 return Flag195
(Id
);
2238 end Is_Primitive_Wrapper
;
2240 function Is_Private_Composite
(Id
: E
) return B
is
2242 pragma Assert
(Is_Type
(Id
));
2243 return Flag107
(Id
);
2244 end Is_Private_Composite
;
2246 function Is_Private_Descendant
(Id
: E
) return B
is
2249 end Is_Private_Descendant
;
2251 function Is_Private_Primitive
(Id
: E
) return B
is
2253 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
2254 return Flag245
(Id
);
2255 end Is_Private_Primitive
;
2257 function Is_Processed_Transient
(Id
: E
) return B
is
2259 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
2260 return Flag252
(Id
);
2261 end Is_Processed_Transient
;
2263 function Is_Public
(Id
: E
) return B
is
2265 pragma Assert
(Nkind
(Id
) in N_Entity
);
2269 function Is_Pure
(Id
: E
) return B
is
2274 function Is_Pure_Unit_Access_Type
(Id
: E
) return B
is
2276 pragma Assert
(Is_Access_Type
(Id
));
2277 return Flag189
(Id
);
2278 end Is_Pure_Unit_Access_Type
;
2280 function Is_RACW_Stub_Type
(Id
: E
) return B
is
2282 pragma Assert
(Is_Type
(Id
));
2283 return Flag244
(Id
);
2284 end Is_RACW_Stub_Type
;
2286 function Is_Raised
(Id
: E
) return B
is
2288 pragma Assert
(Ekind
(Id
) = E_Exception
);
2289 return Flag224
(Id
);
2292 function Is_Remote_Call_Interface
(Id
: E
) return B
is
2295 end Is_Remote_Call_Interface
;
2297 function Is_Remote_Types
(Id
: E
) return B
is
2300 end Is_Remote_Types
;
2302 function Is_Renaming_Of_Object
(Id
: E
) return B
is
2304 return Flag112
(Id
);
2305 end Is_Renaming_Of_Object
;
2307 function Is_Return_Object
(Id
: E
) return B
is
2309 return Flag209
(Id
);
2310 end Is_Return_Object
;
2312 function Is_Safe_To_Reevaluate
(Id
: E
) return B
is
2314 return Flag249
(Id
);
2315 end Is_Safe_To_Reevaluate
;
2317 function Is_Shared_Passive
(Id
: E
) return B
is
2320 end Is_Shared_Passive
;
2322 function Is_Statically_Allocated
(Id
: E
) return B
is
2325 end Is_Statically_Allocated
;
2327 function Is_Tag
(Id
: E
) return B
is
2329 pragma Assert
(Nkind
(Id
) in N_Entity
);
2333 function Is_Tagged_Type
(Id
: E
) return B
is
2338 function Is_Thunk
(Id
: E
) return B
is
2340 return Flag225
(Id
);
2343 function Is_Trivial_Subprogram
(Id
: E
) return B
is
2345 return Flag235
(Id
);
2346 end Is_Trivial_Subprogram
;
2348 function Is_True_Constant
(Id
: E
) return B
is
2350 return Flag163
(Id
);
2351 end Is_True_Constant
;
2353 function Is_Unchecked_Union
(Id
: E
) return B
is
2355 return Flag117
(Implementation_Base_Type
(Id
));
2356 end Is_Unchecked_Union
;
2358 function Is_Underlying_Record_View
(Id
: E
) return B
is
2360 return Flag246
(Id
);
2361 end Is_Underlying_Record_View
;
2363 function Is_Unsigned_Type
(Id
: E
) return B
is
2365 pragma Assert
(Is_Type
(Id
));
2366 return Flag144
(Id
);
2367 end Is_Unsigned_Type
;
2369 function Is_Valued_Procedure
(Id
: E
) return B
is
2371 pragma Assert
(Ekind
(Id
) = E_Procedure
);
2372 return Flag127
(Id
);
2373 end Is_Valued_Procedure
;
2375 function Is_Visible_Formal
(Id
: E
) return B
is
2377 return Flag206
(Id
);
2378 end Is_Visible_Formal
;
2380 function Is_Visible_Lib_Unit
(Id
: E
) return B
is
2382 return Flag116
(Id
);
2383 end Is_Visible_Lib_Unit
;
2385 function Is_VMS_Exception
(Id
: E
) return B
is
2387 return Flag133
(Id
);
2388 end Is_VMS_Exception
;
2390 function Is_Volatile
(Id
: E
) return B
is
2392 pragma Assert
(Nkind
(Id
) in N_Entity
);
2394 if Is_Type
(Id
) then
2395 return Flag16
(Base_Type
(Id
));
2401 function Itype_Printed
(Id
: E
) return B
is
2403 pragma Assert
(Is_Itype
(Id
));
2404 return Flag202
(Id
);
2407 function Kill_Elaboration_Checks
(Id
: E
) return B
is
2410 end Kill_Elaboration_Checks
;
2412 function Kill_Range_Checks
(Id
: E
) return B
is
2415 end Kill_Range_Checks
;
2417 function Known_To_Have_Preelab_Init
(Id
: E
) return B
is
2419 pragma Assert
(Is_Type
(Id
));
2420 return Flag207
(Id
);
2421 end Known_To_Have_Preelab_Init
;
2423 function Last_Aggregate_Assignment
(Id
: E
) return N
is
2425 pragma Assert
(Ekind
(Id
) = E_Variable
);
2427 end Last_Aggregate_Assignment
;
2429 function Last_Assignment
(Id
: E
) return N
is
2431 pragma Assert
(Is_Assignable
(Id
));
2433 end Last_Assignment
;
2435 function Last_Entity
(Id
: E
) return E
is
2440 function Limited_View
(Id
: E
) return E
is
2442 pragma Assert
(Ekind
(Id
) = E_Package
);
2446 function Linker_Section_Pragma
(Id
: E
) return N
is
2449 (Is_Type
(Id
) or else Is_Object
(Id
) or else Is_Subprogram
(Id
));
2451 end Linker_Section_Pragma
;
2453 function Lit_Indexes
(Id
: E
) return E
is
2455 pragma Assert
(Is_Enumeration_Type
(Id
));
2459 function Lit_Strings
(Id
: E
) return E
is
2461 pragma Assert
(Is_Enumeration_Type
(Id
));
2465 function Low_Bound_Tested
(Id
: E
) return B
is
2467 return Flag205
(Id
);
2468 end Low_Bound_Tested
;
2470 function Machine_Radix_10
(Id
: E
) return B
is
2472 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
2474 end Machine_Radix_10
;
2476 function Master_Id
(Id
: E
) return E
is
2478 pragma Assert
(Is_Access_Type
(Id
));
2482 function Materialize_Entity
(Id
: E
) return B
is
2484 return Flag168
(Id
);
2485 end Materialize_Entity
;
2487 function May_Inherit_Delayed_Rep_Aspects
(Id
: E
) return B
is
2489 return Flag262
(Id
);
2490 end May_Inherit_Delayed_Rep_Aspects
;
2492 function Mechanism
(Id
: E
) return M
is
2494 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
2495 return UI_To_Int
(Uint8
(Id
));
2498 function Modulus
(Id
: E
) return Uint
is
2500 pragma Assert
(Is_Modular_Integer_Type
(Id
));
2501 return Uint17
(Base_Type
(Id
));
2504 function Must_Be_On_Byte_Boundary
(Id
: E
) return B
is
2506 pragma Assert
(Is_Type
(Id
));
2507 return Flag183
(Id
);
2508 end Must_Be_On_Byte_Boundary
;
2510 function Must_Have_Preelab_Init
(Id
: E
) return B
is
2512 pragma Assert
(Is_Type
(Id
));
2513 return Flag208
(Id
);
2514 end Must_Have_Preelab_Init
;
2516 function Needs_Debug_Info
(Id
: E
) return B
is
2518 return Flag147
(Id
);
2519 end Needs_Debug_Info
;
2521 function Needs_No_Actuals
(Id
: E
) return B
is
2524 (Is_Overloadable
(Id
)
2525 or else Ekind_In
(Id
, E_Subprogram_Type
, E_Entry_Family
));
2527 end Needs_No_Actuals
;
2529 function Never_Set_In_Source
(Id
: E
) return B
is
2531 return Flag115
(Id
);
2532 end Never_Set_In_Source
;
2534 function Next_Inlined_Subprogram
(Id
: E
) return E
is
2537 end Next_Inlined_Subprogram
;
2539 function No_Pool_Assigned
(Id
: E
) return B
is
2541 pragma Assert
(Is_Access_Type
(Id
));
2542 return Flag131
(Root_Type
(Id
));
2543 end No_Pool_Assigned
;
2545 function No_Return
(Id
: E
) return B
is
2547 return Flag113
(Id
);
2550 function No_Strict_Aliasing
(Id
: E
) return B
is
2552 pragma Assert
(Is_Access_Type
(Id
));
2553 return Flag136
(Base_Type
(Id
));
2554 end No_Strict_Aliasing
;
2556 function Non_Binary_Modulus
(Id
: E
) return B
is
2558 pragma Assert
(Is_Type
(Id
));
2559 return Flag58
(Base_Type
(Id
));
2560 end Non_Binary_Modulus
;
2562 function Non_Limited_View
(Id
: E
) return E
is
2565 (Ekind
(Id
) in Incomplete_Kind
or else Ekind
(Id
) = E_Abstract_State
);
2567 end Non_Limited_View
;
2569 function Nonzero_Is_True
(Id
: E
) return B
is
2571 pragma Assert
(Root_Type
(Id
) = Standard_Boolean
);
2572 return Flag162
(Base_Type
(Id
));
2573 end Nonzero_Is_True
;
2575 function Normalized_First_Bit
(Id
: E
) return U
is
2577 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
2579 end Normalized_First_Bit
;
2581 function Normalized_Position
(Id
: E
) return U
is
2583 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
2585 end Normalized_Position
;
2587 function Normalized_Position_Max
(Id
: E
) return U
is
2589 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
2591 end Normalized_Position_Max
;
2593 function OK_To_Rename
(Id
: E
) return B
is
2595 pragma Assert
(Ekind
(Id
) = E_Variable
);
2596 return Flag247
(Id
);
2599 function OK_To_Reorder_Components
(Id
: E
) return B
is
2601 pragma Assert
(Is_Record_Type
(Id
));
2602 return Flag239
(Base_Type
(Id
));
2603 end OK_To_Reorder_Components
;
2605 function Optimize_Alignment_Space
(Id
: E
) return B
is
2608 (Is_Type
(Id
) or else Ekind_In
(Id
, E_Constant
, E_Variable
));
2609 return Flag241
(Id
);
2610 end Optimize_Alignment_Space
;
2612 function Optimize_Alignment_Time
(Id
: E
) return B
is
2615 (Is_Type
(Id
) or else Ekind_In
(Id
, E_Constant
, E_Variable
));
2616 return Flag242
(Id
);
2617 end Optimize_Alignment_Time
;
2619 function Original_Access_Type
(Id
: E
) return E
is
2621 pragma Assert
(Ekind
(Id
) = E_Access_Subprogram_Type
);
2623 end Original_Access_Type
;
2625 function Original_Array_Type
(Id
: E
) return E
is
2627 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
2629 end Original_Array_Type
;
2631 function Original_Record_Component
(Id
: E
) return E
is
2633 pragma Assert
(Ekind_In
(Id
, E_Void
, E_Component
, E_Discriminant
));
2635 end Original_Record_Component
;
2637 function Overlays_Constant
(Id
: E
) return B
is
2639 return Flag243
(Id
);
2640 end Overlays_Constant
;
2642 function Overridden_Operation
(Id
: E
) return E
is
2645 end Overridden_Operation
;
2647 function Package_Instantiation
(Id
: E
) return N
is
2649 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
));
2651 end Package_Instantiation
;
2653 function Packed_Array_Type
(Id
: E
) return E
is
2655 pragma Assert
(Is_Array_Type
(Id
));
2657 end Packed_Array_Type
;
2659 function Parent_Subtype
(Id
: E
) return E
is
2661 pragma Assert
(Is_Record_Type
(Id
));
2662 return Node19
(Base_Type
(Id
));
2665 function Part_Of_Constituents
(Id
: E
) return L
is
2667 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
2669 end Part_Of_Constituents
;
2671 function Postcondition_Proc
(Id
: E
) return E
is
2673 pragma Assert
(Ekind
(Id
) = E_Procedure
);
2675 end Postcondition_Proc
;
2677 function PPC_Wrapper
(Id
: E
) return E
is
2679 pragma Assert
(Ekind_In
(Id
, E_Entry
, E_Entry_Family
));
2683 function Prival
(Id
: E
) return E
is
2685 pragma Assert
(Is_Protected_Component
(Id
));
2689 function Prival_Link
(Id
: E
) return E
is
2691 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
2695 function Private_Dependents
(Id
: E
) return L
is
2697 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
2698 return Elist18
(Id
);
2699 end Private_Dependents
;
2701 function Private_View
(Id
: E
) return N
is
2703 pragma Assert
(Is_Private_Type
(Id
));
2707 function Protected_Body_Subprogram
(Id
: E
) return E
is
2709 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
2711 end Protected_Body_Subprogram
;
2713 function Protected_Formal
(Id
: E
) return E
is
2715 pragma Assert
(Is_Formal
(Id
));
2717 end Protected_Formal
;
2719 function Protection_Object
(Id
: E
) return E
is
2722 (Ekind_In
(Id
, E_Entry
, E_Entry_Family
, E_Function
, E_Procedure
));
2724 end Protection_Object
;
2726 function Reachable
(Id
: E
) return B
is
2731 function Referenced
(Id
: E
) return B
is
2733 return Flag156
(Id
);
2736 function Referenced_As_LHS
(Id
: E
) return B
is
2739 end Referenced_As_LHS
;
2741 function Referenced_As_Out_Parameter
(Id
: E
) return B
is
2743 return Flag227
(Id
);
2744 end Referenced_As_Out_Parameter
;
2746 function Refinement_Constituents
(Id
: E
) return L
is
2748 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
2750 end Refinement_Constituents
;
2752 function Register_Exception_Call
(Id
: E
) return N
is
2754 pragma Assert
(Ekind
(Id
) = E_Exception
);
2756 end Register_Exception_Call
;
2758 function Related_Array_Object
(Id
: E
) return E
is
2760 pragma Assert
(Is_Array_Type
(Id
));
2762 end Related_Array_Object
;
2764 function Related_Expression
(Id
: E
) return N
is
2766 pragma Assert
(Ekind
(Id
) in Type_Kind
2767 or else Ekind_In
(Id
, E_Constant
, E_Variable
));
2769 end Related_Expression
;
2771 function Related_Instance
(Id
: E
) return E
is
2773 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Package_Body
));
2775 end Related_Instance
;
2777 function Related_Type
(Id
: E
) return E
is
2779 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Constant
, E_Variable
));
2783 function Relative_Deadline_Variable
(Id
: E
) return E
is
2785 pragma Assert
(Is_Task_Type
(Id
));
2786 return Node26
(Implementation_Base_Type
(Id
));
2787 end Relative_Deadline_Variable
;
2789 function Renamed_Entity
(Id
: E
) return N
is
2794 function Renamed_In_Spec
(Id
: E
) return B
is
2796 pragma Assert
(Ekind
(Id
) = E_Package
);
2797 return Flag231
(Id
);
2798 end Renamed_In_Spec
;
2800 function Renamed_Object
(Id
: E
) return N
is
2805 function Renaming_Map
(Id
: E
) return U
is
2810 function Requires_Overriding
(Id
: E
) return B
is
2812 pragma Assert
(Is_Overloadable
(Id
));
2813 return Flag213
(Id
);
2814 end Requires_Overriding
;
2816 function Return_Present
(Id
: E
) return B
is
2821 function Return_Applies_To
(Id
: E
) return N
is
2824 end Return_Applies_To
;
2826 function Returns_By_Ref
(Id
: E
) return B
is
2831 function Reverse_Bit_Order
(Id
: E
) return B
is
2833 pragma Assert
(Is_Record_Type
(Id
));
2834 return Flag164
(Base_Type
(Id
));
2835 end Reverse_Bit_Order
;
2837 function Reverse_Storage_Order
(Id
: E
) return B
is
2839 pragma Assert
(Is_Record_Type
(Id
) or else Is_Array_Type
(Id
));
2840 return Flag93
(Base_Type
(Id
));
2841 end Reverse_Storage_Order
;
2843 function RM_Size
(Id
: E
) return U
is
2845 pragma Assert
(Is_Type
(Id
));
2849 function Scalar_Range
(Id
: E
) return N
is
2854 function Scale_Value
(Id
: E
) return U
is
2859 function Scope_Depth_Value
(Id
: E
) return U
is
2862 end Scope_Depth_Value
;
2864 function Sec_Stack_Needed_For_Return
(Id
: E
) return B
is
2866 return Flag167
(Id
);
2867 end Sec_Stack_Needed_For_Return
;
2869 function Shadow_Entities
(Id
: E
) return S
is
2871 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
));
2873 end Shadow_Entities
;
2875 function Shared_Var_Procs_Instance
(Id
: E
) return E
is
2877 pragma Assert
(Ekind
(Id
) = E_Variable
);
2879 end Shared_Var_Procs_Instance
;
2881 function Size_Check_Code
(Id
: E
) return N
is
2883 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
2885 end Size_Check_Code
;
2887 function Size_Depends_On_Discriminant
(Id
: E
) return B
is
2889 return Flag177
(Id
);
2890 end Size_Depends_On_Discriminant
;
2892 function Size_Known_At_Compile_Time
(Id
: E
) return B
is
2895 end Size_Known_At_Compile_Time
;
2897 function Small_Value
(Id
: E
) return R
is
2899 pragma Assert
(Is_Fixed_Point_Type
(Id
));
2900 return Ureal21
(Id
);
2903 function SPARK_Aux_Pragma
(Id
: E
) return N
is
2906 (Ekind_In
(Id
, E_Generic_Package
, -- package variants
2910 end SPARK_Aux_Pragma
;
2912 function SPARK_Aux_Pragma_Inherited
(Id
: E
) return B
is
2915 (Ekind_In
(Id
, E_Generic_Package
, -- package variants
2918 return Flag266
(Id
);
2919 end SPARK_Aux_Pragma_Inherited
;
2921 function SPARK_Pragma
(Id
: E
) return N
is
2924 (Ekind_In
(Id
, E_Function
, -- subprogram variants
2926 E_Generic_Procedure
,
2930 Ekind_In
(Id
, E_Generic_Package
, -- package variants
2936 function SPARK_Pragma_Inherited
(Id
: E
) return B
is
2939 (Ekind_In
(Id
, E_Function
, -- subprogram variants
2941 E_Generic_Procedure
,
2945 Ekind_In
(Id
, E_Generic_Package
, -- package variants
2948 return Flag265
(Id
);
2949 end SPARK_Pragma_Inherited
;
2951 function Spec_Entity
(Id
: E
) return E
is
2953 pragma Assert
(Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
2957 function Static_Predicate
(Id
: E
) return S
is
2959 pragma Assert
(Is_Discrete_Type
(Id
));
2961 end Static_Predicate
;
2963 function Status_Flag_Or_Transient_Decl
(Id
: E
) return N
is
2965 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
2967 end Status_Flag_Or_Transient_Decl
;
2969 function Storage_Size_Variable
(Id
: E
) return E
is
2971 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
2972 return Node15
(Implementation_Base_Type
(Id
));
2973 end Storage_Size_Variable
;
2975 function Static_Elaboration_Desired
(Id
: E
) return B
is
2977 pragma Assert
(Ekind
(Id
) = E_Package
);
2979 end Static_Elaboration_Desired
;
2981 function Static_Initialization
(Id
: E
) return N
is
2984 (Ekind
(Id
) = E_Procedure
and then not Is_Dispatching_Operation
(Id
));
2986 end Static_Initialization
;
2988 function Stored_Constraint
(Id
: E
) return L
is
2991 (Is_Composite_Type
(Id
) and then not Is_Array_Type
(Id
));
2992 return Elist23
(Id
);
2993 end Stored_Constraint
;
2995 function Strict_Alignment
(Id
: E
) return B
is
2997 return Flag145
(Implementation_Base_Type
(Id
));
2998 end Strict_Alignment
;
3000 function String_Literal_Length
(Id
: E
) return U
is
3003 end String_Literal_Length
;
3005 function String_Literal_Low_Bound
(Id
: E
) return N
is
3008 end String_Literal_Low_Bound
;
3010 function Subprograms_For_Type
(Id
: E
) return E
is
3012 pragma Assert
(Is_Type
(Id
) or else Is_Subprogram
(Id
));
3014 end Subprograms_For_Type
;
3016 function Suppress_Elaboration_Warnings
(Id
: E
) return B
is
3018 return Flag148
(Id
);
3019 end Suppress_Elaboration_Warnings
;
3021 function Suppress_Initialization
(Id
: E
) return B
is
3023 pragma Assert
(Is_Type
(Id
));
3024 return Flag105
(Id
);
3025 end Suppress_Initialization
;
3027 function Suppress_Style_Checks
(Id
: E
) return B
is
3029 return Flag165
(Id
);
3030 end Suppress_Style_Checks
;
3032 function Suppress_Value_Tracking_On_Call
(Id
: E
) return B
is
3034 return Flag217
(Id
);
3035 end Suppress_Value_Tracking_On_Call
;
3037 function Task_Body_Procedure
(Id
: E
) return N
is
3039 pragma Assert
(Ekind
(Id
) in Task_Kind
);
3041 end Task_Body_Procedure
;
3043 function Thunk_Entity
(Id
: E
) return E
is
3045 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
)
3046 and then Is_Thunk
(Id
));
3050 function Treat_As_Volatile
(Id
: E
) return B
is
3053 end Treat_As_Volatile
;
3055 function Underlying_Full_View
(Id
: E
) return E
is
3057 pragma Assert
(Ekind
(Id
) in Private_Kind
);
3059 end Underlying_Full_View
;
3061 function Underlying_Record_View
(Id
: E
) return E
is
3064 end Underlying_Record_View
;
3066 function Universal_Aliasing
(Id
: E
) return B
is
3068 pragma Assert
(Is_Type
(Id
));
3069 return Flag216
(Implementation_Base_Type
(Id
));
3070 end Universal_Aliasing
;
3072 function Unset_Reference
(Id
: E
) return N
is
3075 end Unset_Reference
;
3077 function Used_As_Generic_Actual
(Id
: E
) return B
is
3079 return Flag222
(Id
);
3080 end Used_As_Generic_Actual
;
3082 function Uses_Lock_Free
(Id
: E
) return B
is
3084 pragma Assert
(Is_Protected_Type
(Id
));
3085 return Flag188
(Id
);
3088 function Uses_Sec_Stack
(Id
: E
) return B
is
3093 function Warnings_Off
(Id
: E
) return B
is
3098 function Warnings_Off_Used
(Id
: E
) return B
is
3100 return Flag236
(Id
);
3101 end Warnings_Off_Used
;
3103 function Warnings_Off_Used_Unmodified
(Id
: E
) return B
is
3105 return Flag237
(Id
);
3106 end Warnings_Off_Used_Unmodified
;
3108 function Warnings_Off_Used_Unreferenced
(Id
: E
) return B
is
3110 return Flag238
(Id
);
3111 end Warnings_Off_Used_Unreferenced
;
3113 function Wrapped_Entity
(Id
: E
) return E
is
3115 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
)
3116 and then Is_Primitive_Wrapper
(Id
));
3120 function Was_Hidden
(Id
: E
) return B
is
3122 return Flag196
(Id
);
3125 ------------------------------
3126 -- Classification Functions --
3127 ------------------------------
3129 function Is_Access_Type
(Id
: E
) return B
is
3131 return Ekind
(Id
) in Access_Kind
;
3134 function Is_Access_Protected_Subprogram_Type
(Id
: E
) return B
is
3136 return Ekind
(Id
) in Access_Protected_Kind
;
3137 end Is_Access_Protected_Subprogram_Type
;
3139 function Is_Access_Subprogram_Type
(Id
: E
) return B
is
3141 return Ekind
(Id
) in Access_Subprogram_Kind
;
3142 end Is_Access_Subprogram_Type
;
3144 function Is_Aggregate_Type
(Id
: E
) return B
is
3146 return Ekind
(Id
) in Aggregate_Kind
;
3147 end Is_Aggregate_Type
;
3149 function Is_Array_Type
(Id
: E
) return B
is
3151 return Ekind
(Id
) in Array_Kind
;
3154 function Is_Assignable
(Id
: E
) return B
is
3156 return Ekind
(Id
) in Assignable_Kind
;
3159 function Is_Class_Wide_Type
(Id
: E
) return B
is
3161 return Ekind
(Id
) in Class_Wide_Kind
;
3162 end Is_Class_Wide_Type
;
3164 function Is_Composite_Type
(Id
: E
) return B
is
3166 return Ekind
(Id
) in Composite_Kind
;
3167 end Is_Composite_Type
;
3169 function Is_Concurrent_Body
(Id
: E
) return B
is
3171 return Ekind
(Id
) in
3172 Concurrent_Body_Kind
;
3173 end Is_Concurrent_Body
;
3175 function Is_Concurrent_Record_Type
(Id
: E
) return B
is
3178 end Is_Concurrent_Record_Type
;
3180 function Is_Concurrent_Type
(Id
: E
) return B
is
3182 return Ekind
(Id
) in Concurrent_Kind
;
3183 end Is_Concurrent_Type
;
3185 function Is_Decimal_Fixed_Point_Type
(Id
: E
) return B
is
3187 return Ekind
(Id
) in
3188 Decimal_Fixed_Point_Kind
;
3189 end Is_Decimal_Fixed_Point_Type
;
3191 function Is_Digits_Type
(Id
: E
) return B
is
3193 return Ekind
(Id
) in Digits_Kind
;
3196 function Is_Discrete_Or_Fixed_Point_Type
(Id
: E
) return B
is
3198 return Ekind
(Id
) in Discrete_Or_Fixed_Point_Kind
;
3199 end Is_Discrete_Or_Fixed_Point_Type
;
3201 function Is_Discrete_Type
(Id
: E
) return B
is
3203 return Ekind
(Id
) in Discrete_Kind
;
3204 end Is_Discrete_Type
;
3206 function Is_Elementary_Type
(Id
: E
) return B
is
3208 return Ekind
(Id
) in Elementary_Kind
;
3209 end Is_Elementary_Type
;
3211 function Is_Entry
(Id
: E
) return B
is
3213 return Ekind
(Id
) in Entry_Kind
;
3216 function Is_Enumeration_Type
(Id
: E
) return B
is
3218 return Ekind
(Id
) in
3220 end Is_Enumeration_Type
;
3222 function Is_Fixed_Point_Type
(Id
: E
) return B
is
3224 return Ekind
(Id
) in
3226 end Is_Fixed_Point_Type
;
3228 function Is_Floating_Point_Type
(Id
: E
) return B
is
3230 return Ekind
(Id
) in Float_Kind
;
3231 end Is_Floating_Point_Type
;
3233 function Is_Formal
(Id
: E
) return B
is
3235 return Ekind
(Id
) in Formal_Kind
;
3238 function Is_Formal_Object
(Id
: E
) return B
is
3240 return Ekind
(Id
) in Formal_Object_Kind
;
3241 end Is_Formal_Object
;
3243 function Is_Generic_Subprogram
(Id
: E
) return B
is
3245 return Ekind
(Id
) in Generic_Subprogram_Kind
;
3246 end Is_Generic_Subprogram
;
3248 function Is_Generic_Unit
(Id
: E
) return B
is
3250 return Ekind
(Id
) in Generic_Unit_Kind
;
3251 end Is_Generic_Unit
;
3253 function Is_Incomplete_Or_Private_Type
(Id
: E
) return B
is
3255 return Ekind
(Id
) in
3256 Incomplete_Or_Private_Kind
;
3257 end Is_Incomplete_Or_Private_Type
;
3259 function Is_Incomplete_Type
(Id
: E
) return B
is
3261 return Ekind
(Id
) in
3263 end Is_Incomplete_Type
;
3265 function Is_Integer_Type
(Id
: E
) return B
is
3267 return Ekind
(Id
) in Integer_Kind
;
3268 end Is_Integer_Type
;
3270 function Is_Modular_Integer_Type
(Id
: E
) return B
is
3272 return Ekind
(Id
) in
3273 Modular_Integer_Kind
;
3274 end Is_Modular_Integer_Type
;
3276 function Is_Named_Number
(Id
: E
) return B
is
3278 return Ekind
(Id
) in Named_Kind
;
3279 end Is_Named_Number
;
3281 function Is_Numeric_Type
(Id
: E
) return B
is
3283 return Ekind
(Id
) in Numeric_Kind
;
3284 end Is_Numeric_Type
;
3286 function Is_Object
(Id
: E
) return B
is
3288 return Ekind
(Id
) in Object_Kind
;
3291 function Is_Ordinary_Fixed_Point_Type
(Id
: E
) return B
is
3293 return Ekind
(Id
) in
3294 Ordinary_Fixed_Point_Kind
;
3295 end Is_Ordinary_Fixed_Point_Type
;
3297 function Is_Overloadable
(Id
: E
) return B
is
3299 return Ekind
(Id
) in Overloadable_Kind
;
3300 end Is_Overloadable
;
3302 function Is_Private_Type
(Id
: E
) return B
is
3304 return Ekind
(Id
) in Private_Kind
;
3305 end Is_Private_Type
;
3307 function Is_Protected_Type
(Id
: E
) return B
is
3309 return Ekind
(Id
) in Protected_Kind
;
3310 end Is_Protected_Type
;
3312 function Is_Real_Type
(Id
: E
) return B
is
3314 return Ekind
(Id
) in Real_Kind
;
3317 function Is_Record_Type
(Id
: E
) return B
is
3319 return Ekind
(Id
) in Record_Kind
;
3322 function Is_Scalar_Type
(Id
: E
) return B
is
3324 return Ekind
(Id
) in Scalar_Kind
;
3327 function Is_Signed_Integer_Type
(Id
: E
) return B
is
3329 return Ekind
(Id
) in Signed_Integer_Kind
;
3330 end Is_Signed_Integer_Type
;
3332 function Is_Subprogram
(Id
: E
) return B
is
3334 return Ekind
(Id
) in Subprogram_Kind
;
3337 function Is_Task_Type
(Id
: E
) return B
is
3339 return Ekind
(Id
) in Task_Kind
;
3342 function Is_Type
(Id
: E
) return B
is
3344 return Ekind
(Id
) in Type_Kind
;
3347 ------------------------------
3348 -- Attribute Set Procedures --
3349 ------------------------------
3351 -- Note: in many of these set procedures an "obvious" assertion is missing.
3352 -- The reason for this is that in many cases, a field is set before the
3353 -- Ekind field is set, so that the field is set when Ekind = E_Void. It
3354 -- it is possible to add assertions that specifically include the E_Void
3355 -- possibility, but in some cases, we just omit the assertions.
3357 procedure Set_Abstract_States
(Id
: E
; V
: L
) is
3359 pragma Assert
(Ekind_In
(Id
, E_Generic_Package
, E_Package
));
3360 Set_Elist25
(Id
, V
);
3361 end Set_Abstract_States
;
3363 procedure Set_Accept_Address
(Id
: E
; V
: L
) is
3365 Set_Elist21
(Id
, V
);
3366 end Set_Accept_Address
;
3368 procedure Set_Access_Disp_Table
(Id
: E
; V
: L
) is
3370 pragma Assert
(Ekind
(Id
) = E_Record_Type
3371 and then Id
= Implementation_Base_Type
(Id
));
3372 pragma Assert
(V
= No_Elist
or else Is_Tagged_Type
(Id
));
3373 Set_Elist16
(Id
, V
);
3374 end Set_Access_Disp_Table
;
3376 procedure Set_Associated_Formal_Package
(Id
: E
; V
: E
) is
3379 end Set_Associated_Formal_Package
;
3381 procedure Set_Associated_Node_For_Itype
(Id
: E
; V
: E
) is
3384 end Set_Associated_Node_For_Itype
;
3386 procedure Set_Associated_Storage_Pool
(Id
: E
; V
: E
) is
3388 pragma Assert
(Is_Access_Type
(Id
) and then Is_Base_Type
(Id
));
3390 end Set_Associated_Storage_Pool
;
3392 procedure Set_Actual_Subtype
(Id
: E
; V
: E
) is
3395 (Ekind_In
(Id
, E_Constant
, E_Variable
, E_Generic_In_Out_Parameter
)
3396 or else Is_Formal
(Id
));
3398 end Set_Actual_Subtype
;
3400 procedure Set_Address_Taken
(Id
: E
; V
: B
:= True) is
3402 Set_Flag104
(Id
, V
);
3403 end Set_Address_Taken
;
3405 procedure Set_Alias
(Id
: E
; V
: E
) is
3408 (Is_Overloadable
(Id
) or else Ekind
(Id
) = E_Subprogram_Type
);
3412 procedure Set_Alignment
(Id
: E
; V
: U
) is
3414 pragma Assert
(Is_Type
(Id
)
3415 or else Is_Formal
(Id
)
3416 or else Ekind_In
(Id
, E_Loop_Parameter
,
3423 procedure Set_Barrier_Function
(Id
: E
; V
: N
) is
3425 pragma Assert
(Is_Entry
(Id
));
3427 end Set_Barrier_Function
;
3429 procedure Set_Block_Node
(Id
: E
; V
: N
) is
3431 pragma Assert
(Ekind
(Id
) = E_Block
);
3435 procedure Set_Body_Entity
(Id
: E
; V
: E
) is
3437 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
));
3439 end Set_Body_Entity
;
3441 procedure Set_Body_Needed_For_SAL
(Id
: E
; V
: B
:= True) is
3444 (Ekind
(Id
) = E_Package
3445 or else Is_Subprogram
(Id
)
3446 or else Is_Generic_Unit
(Id
));
3448 end Set_Body_Needed_For_SAL
;
3450 procedure Set_Body_References
(Id
: E
; V
: L
) is
3452 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
3453 Set_Elist16
(Id
, V
);
3454 end Set_Body_References
;
3456 procedure Set_BIP_Initialization_Call
(Id
: E
; V
: N
) is
3458 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
3460 end Set_BIP_Initialization_Call
;
3462 procedure Set_C_Pass_By_Copy
(Id
: E
; V
: B
:= True) is
3464 pragma Assert
(Is_Record_Type
(Id
) and then Is_Base_Type
(Id
));
3465 Set_Flag125
(Id
, V
);
3466 end Set_C_Pass_By_Copy
;
3468 procedure Set_Can_Never_Be_Null
(Id
: E
; V
: B
:= True) is
3471 end Set_Can_Never_Be_Null
;
3473 procedure Set_Checks_May_Be_Suppressed
(Id
: E
; V
: B
:= True) is
3476 end Set_Checks_May_Be_Suppressed
;
3478 procedure Set_Class_Wide_Type
(Id
: E
; V
: E
) is
3480 pragma Assert
(Is_Type
(Id
));
3482 end Set_Class_Wide_Type
;
3484 procedure Set_Cloned_Subtype
(Id
: E
; V
: E
) is
3486 pragma Assert
(Ekind_In
(Id
, E_Record_Subtype
, E_Class_Wide_Subtype
));
3488 end Set_Cloned_Subtype
;
3490 procedure Set_Component_Bit_Offset
(Id
: E
; V
: U
) is
3492 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
3494 end Set_Component_Bit_Offset
;
3496 procedure Set_Component_Clause
(Id
: E
; V
: N
) is
3498 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
3500 end Set_Component_Clause
;
3502 procedure Set_Component_Size
(Id
: E
; V
: U
) is
3504 pragma Assert
(Is_Array_Type
(Id
) and then Is_Base_Type
(Id
));
3506 end Set_Component_Size
;
3508 procedure Set_Component_Type
(Id
: E
; V
: E
) is
3510 pragma Assert
(Is_Array_Type
(Id
) and then Is_Base_Type
(Id
));
3512 end Set_Component_Type
;
3514 procedure Set_Corresponding_Concurrent_Type
(Id
: E
; V
: E
) is
3517 (Ekind
(Id
) = E_Record_Type
and then Is_Concurrent_Type
(V
));
3519 end Set_Corresponding_Concurrent_Type
;
3521 procedure Set_Corresponding_Discriminant
(Id
: E
; V
: E
) is
3523 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3525 end Set_Corresponding_Discriminant
;
3527 procedure Set_Corresponding_Equality
(Id
: E
; V
: E
) is
3530 (Ekind
(Id
) = E_Function
3531 and then not Comes_From_Source
(Id
)
3532 and then Chars
(Id
) = Name_Op_Ne
);
3534 end Set_Corresponding_Equality
;
3536 procedure Set_Corresponding_Protected_Entry
(Id
: E
; V
: E
) is
3538 pragma Assert
(Ekind_In
(Id
, E_Void
, E_Subprogram_Body
));
3540 end Set_Corresponding_Protected_Entry
;
3542 procedure Set_Corresponding_Record_Type
(Id
: E
; V
: E
) is
3544 pragma Assert
(Is_Concurrent_Type
(Id
));
3546 end Set_Corresponding_Record_Type
;
3548 procedure Set_Corresponding_Remote_Type
(Id
: E
; V
: E
) is
3551 end Set_Corresponding_Remote_Type
;
3553 procedure Set_Current_Use_Clause
(Id
: E
; V
: E
) is
3555 pragma Assert
(Ekind
(Id
) = E_Package
or else Is_Type
(Id
));
3557 end Set_Current_Use_Clause
;
3559 procedure Set_Current_Value
(Id
: E
; V
: N
) is
3561 pragma Assert
(Ekind
(Id
) in Object_Kind
or else Ekind
(Id
) = E_Void
);
3563 end Set_Current_Value
;
3565 procedure Set_CR_Discriminant
(Id
: E
; V
: E
) is
3568 end Set_CR_Discriminant
;
3570 procedure Set_Debug_Info_Off
(Id
: E
; V
: B
:= True) is
3572 Set_Flag166
(Id
, V
);
3573 end Set_Debug_Info_Off
;
3575 procedure Set_Debug_Renaming_Link
(Id
: E
; V
: E
) is
3578 end Set_Debug_Renaming_Link
;
3580 procedure Set_Default_Aspect_Component_Value
(Id
: E
; V
: E
) is
3582 pragma Assert
(Is_Array_Type
(Id
) and then Is_Base_Type
(Id
));
3584 end Set_Default_Aspect_Component_Value
;
3586 procedure Set_Default_Aspect_Value
(Id
: E
; V
: E
) is
3588 pragma Assert
(Is_Scalar_Type
(Id
) and then Is_Base_Type
(Id
));
3590 end Set_Default_Aspect_Value
;
3592 procedure Set_Default_Expr_Function
(Id
: E
; V
: E
) is
3594 pragma Assert
(Is_Formal
(Id
));
3596 end Set_Default_Expr_Function
;
3598 procedure Set_Default_Expressions_Processed
(Id
: E
; V
: B
:= True) is
3600 Set_Flag108
(Id
, V
);
3601 end Set_Default_Expressions_Processed
;
3603 procedure Set_Default_Value
(Id
: E
; V
: N
) is
3605 pragma Assert
(Is_Formal
(Id
));
3607 end Set_Default_Value
;
3609 procedure Set_Delay_Cleanups
(Id
: E
; V
: B
:= True) is
3613 or else Is_Task_Type
(Id
)
3614 or else Ekind
(Id
) = E_Block
);
3615 Set_Flag114
(Id
, V
);
3616 end Set_Delay_Cleanups
;
3618 procedure Set_Delay_Subprogram_Descriptors
(Id
: E
; V
: B
:= True) is
3621 (Is_Subprogram
(Id
) or else Ekind_In
(Id
, E_Package
, E_Package_Body
));
3624 end Set_Delay_Subprogram_Descriptors
;
3626 procedure Set_Delta_Value
(Id
: E
; V
: R
) is
3628 pragma Assert
(Is_Fixed_Point_Type
(Id
));
3629 Set_Ureal18
(Id
, V
);
3630 end Set_Delta_Value
;
3632 procedure Set_Dependent_Instances
(Id
: E
; V
: L
) is
3634 pragma Assert
(Is_Generic_Instance
(Id
));
3636 end Set_Dependent_Instances
;
3638 procedure Set_Depends_On_Private
(Id
: E
; V
: B
:= True) is
3640 pragma Assert
(Nkind
(Id
) in N_Entity
);
3642 end Set_Depends_On_Private
;
3644 procedure Set_Digits_Value
(Id
: E
; V
: U
) is
3647 (Is_Floating_Point_Type
(Id
)
3648 or else Is_Decimal_Fixed_Point_Type
(Id
));
3650 end Set_Digits_Value
;
3652 procedure Set_Directly_Designated_Type
(Id
: E
; V
: E
) is
3655 end Set_Directly_Designated_Type
;
3657 procedure Set_Discard_Names
(Id
: E
; V
: B
:= True) is
3660 end Set_Discard_Names
;
3662 procedure Set_Discriminal
(Id
: E
; V
: E
) is
3664 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
3666 end Set_Discriminal
;
3668 procedure Set_Discriminal_Link
(Id
: E
; V
: E
) is
3671 end Set_Discriminal_Link
;
3673 procedure Set_Discriminant_Checking_Func
(Id
: E
; V
: E
) is
3675 pragma Assert
(Ekind
(Id
) = E_Component
);
3677 end Set_Discriminant_Checking_Func
;
3679 procedure Set_Discriminant_Constraint
(Id
: E
; V
: L
) is
3681 pragma Assert
(Nkind
(Id
) in N_Entity
);
3682 Set_Elist21
(Id
, V
);
3683 end Set_Discriminant_Constraint
;
3685 procedure Set_Discriminant_Default_Value
(Id
: E
; V
: N
) is
3688 end Set_Discriminant_Default_Value
;
3690 procedure Set_Discriminant_Number
(Id
: E
; V
: U
) is
3693 end Set_Discriminant_Number
;
3695 procedure Set_Dispatch_Table_Wrappers
(Id
: E
; V
: L
) is
3697 pragma Assert
(Ekind
(Id
) = E_Record_Type
3698 and then Id
= Implementation_Base_Type
(Id
));
3699 pragma Assert
(V
= No_Elist
or else Is_Tagged_Type
(Id
));
3700 Set_Elist26
(Id
, V
);
3701 end Set_Dispatch_Table_Wrappers
;
3703 procedure Set_DT_Entry_Count
(Id
: E
; V
: U
) is
3705 pragma Assert
(Ekind
(Id
) = E_Component
);
3707 end Set_DT_Entry_Count
;
3709 procedure Set_DT_Offset_To_Top_Func
(Id
: E
; V
: E
) is
3711 pragma Assert
(Ekind
(Id
) = E_Component
and then Is_Tag
(Id
));
3713 end Set_DT_Offset_To_Top_Func
;
3715 procedure Set_DT_Position
(Id
: E
; V
: U
) is
3717 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
3719 end Set_DT_Position
;
3721 procedure Set_DTC_Entity
(Id
: E
; V
: E
) is
3723 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
3727 procedure Set_Elaborate_Body_Desirable
(Id
: E
; V
: B
:= True) is
3729 pragma Assert
(Ekind
(Id
) = E_Package
);
3730 Set_Flag210
(Id
, V
);
3731 end Set_Elaborate_Body_Desirable
;
3733 procedure Set_Elaboration_Entity
(Id
: E
; V
: E
) is
3738 Ekind
(Id
) = E_Package
3740 Is_Generic_Unit
(Id
));
3742 end Set_Elaboration_Entity
;
3744 procedure Set_Elaboration_Entity_Required
(Id
: E
; V
: B
:= True) is
3749 Ekind
(Id
) = E_Package
3751 Is_Generic_Unit
(Id
));
3752 Set_Flag174
(Id
, V
);
3753 end Set_Elaboration_Entity_Required
;
3755 procedure Set_Encapsulating_State
(Id
: E
; V
: E
) is
3757 pragma Assert
(Ekind_In
(Id
, E_Abstract_State
, E_Variable
));
3759 end Set_Encapsulating_State
;
3761 procedure Set_Enclosing_Scope
(Id
: E
; V
: E
) is
3764 end Set_Enclosing_Scope
;
3766 procedure Set_Entry_Accepted
(Id
: E
; V
: B
:= True) is
3768 pragma Assert
(Is_Entry
(Id
));
3769 Set_Flag152
(Id
, V
);
3770 end Set_Entry_Accepted
;
3772 procedure Set_Entry_Bodies_Array
(Id
: E
; V
: E
) is
3775 end Set_Entry_Bodies_Array
;
3777 procedure Set_Entry_Cancel_Parameter
(Id
: E
; V
: E
) is
3780 end Set_Entry_Cancel_Parameter
;
3782 procedure Set_Entry_Component
(Id
: E
; V
: E
) is
3785 end Set_Entry_Component
;
3787 procedure Set_Entry_Formal
(Id
: E
; V
: E
) is
3790 end Set_Entry_Formal
;
3792 procedure Set_Entry_Index_Constant
(Id
: E
; V
: E
) is
3794 pragma Assert
(Ekind
(Id
) = E_Entry_Index_Parameter
);
3796 end Set_Entry_Index_Constant
;
3798 procedure Set_Contract
(Id
: E
; V
: N
) is
3801 (Ekind_In
(Id
, E_Entry
,
3809 or else Is_Generic_Subprogram
(Id
)
3810 or else Is_Subprogram
(Id
));
3814 procedure Set_Entry_Parameters_Type
(Id
: E
; V
: E
) is
3817 end Set_Entry_Parameters_Type
;
3819 procedure Set_Enum_Pos_To_Rep
(Id
: E
; V
: E
) is
3821 pragma Assert
(Ekind
(Id
) = E_Enumeration_Type
);
3823 end Set_Enum_Pos_To_Rep
;
3825 procedure Set_Enumeration_Pos
(Id
: E
; V
: U
) is
3827 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3829 end Set_Enumeration_Pos
;
3831 procedure Set_Enumeration_Rep
(Id
: E
; V
: U
) is
3833 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3835 end Set_Enumeration_Rep
;
3837 procedure Set_Enumeration_Rep_Expr
(Id
: E
; V
: N
) is
3839 pragma Assert
(Ekind
(Id
) = E_Enumeration_Literal
);
3841 end Set_Enumeration_Rep_Expr
;
3843 procedure Set_Equivalent_Type
(Id
: E
; V
: E
) is
3846 (Ekind_In
(Id
, E_Class_Wide_Type
,
3847 E_Class_Wide_Subtype
,
3848 E_Access_Protected_Subprogram_Type
,
3849 E_Anonymous_Access_Protected_Subprogram_Type
,
3850 E_Access_Subprogram_Type
,
3853 end Set_Equivalent_Type
;
3855 procedure Set_Esize
(Id
: E
; V
: U
) is
3860 procedure Set_Exception_Code
(Id
: E
; V
: U
) is
3862 pragma Assert
(Ekind
(Id
) = E_Exception
);
3864 end Set_Exception_Code
;
3866 procedure Set_Extra_Accessibility
(Id
: E
; V
: E
) is
3869 (Is_Formal
(Id
) or else Ekind_In
(Id
, E_Variable
, E_Constant
));
3871 end Set_Extra_Accessibility
;
3873 procedure Set_Extra_Accessibility_Of_Result
(Id
: E
; V
: E
) is
3875 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Operator
, E_Subprogram_Type
));
3877 end Set_Extra_Accessibility_Of_Result
;
3879 procedure Set_Extra_Constrained
(Id
: E
; V
: E
) is
3881 pragma Assert
(Is_Formal
(Id
) or else Ekind
(Id
) = E_Variable
);
3883 end Set_Extra_Constrained
;
3885 procedure Set_Extra_Formal
(Id
: E
; V
: E
) is
3888 end Set_Extra_Formal
;
3890 procedure Set_Extra_Formals
(Id
: E
; V
: E
) is
3893 (Is_Overloadable
(Id
)
3894 or else Ekind_In
(Id
, E_Entry_Family
,
3896 E_Subprogram_Type
));
3898 end Set_Extra_Formals
;
3900 procedure Set_Can_Use_Internal_Rep
(Id
: E
; V
: B
:= True) is
3903 (Is_Access_Subprogram_Type
(Id
) and then Is_Base_Type
(Id
));
3904 Set_Flag229
(Id
, V
);
3905 end Set_Can_Use_Internal_Rep
;
3907 procedure Set_Finalization_Master
(Id
: E
; V
: E
) is
3909 pragma Assert
(Is_Access_Type
(Id
) and then Is_Base_Type
(Id
));
3911 end Set_Finalization_Master
;
3913 procedure Set_Finalize_Storage_Only
(Id
: E
; V
: B
:= True) is
3915 pragma Assert
(Is_Type
(Id
) and then Is_Base_Type
(Id
));
3916 Set_Flag158
(Id
, V
);
3917 end Set_Finalize_Storage_Only
;
3919 procedure Set_Finalizer
(Id
: E
; V
: E
) is
3921 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Package_Body
));
3925 procedure Set_First_Entity
(Id
: E
; V
: E
) is
3928 end Set_First_Entity
;
3930 procedure Set_First_Exit_Statement
(Id
: E
; V
: N
) is
3932 pragma Assert
(Ekind
(Id
) = E_Loop
);
3934 end Set_First_Exit_Statement
;
3936 procedure Set_First_Index
(Id
: E
; V
: N
) is
3938 pragma Assert
(Is_Array_Type
(Id
) or else Is_String_Type
(Id
));
3940 end Set_First_Index
;
3942 procedure Set_First_Literal
(Id
: E
; V
: E
) is
3944 pragma Assert
(Is_Enumeration_Type
(Id
));
3946 end Set_First_Literal
;
3948 procedure Set_First_Optional_Parameter
(Id
: E
; V
: E
) is
3950 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
3952 end Set_First_Optional_Parameter
;
3954 procedure Set_First_Private_Entity
(Id
: E
; V
: E
) is
3956 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
)
3957 or else Ekind
(Id
) in Concurrent_Kind
);
3959 end Set_First_Private_Entity
;
3961 procedure Set_First_Rep_Item
(Id
: E
; V
: N
) is
3964 end Set_First_Rep_Item
;
3966 procedure Set_Float_Rep
(Id
: E
; V
: F
) is
3967 pragma Assert
(Ekind
(Id
) = E_Floating_Point_Type
);
3969 Set_Uint10
(Id
, UI_From_Int
(F
'Pos (V
)));
3972 procedure Set_Freeze_Node
(Id
: E
; V
: N
) is
3975 end Set_Freeze_Node
;
3977 procedure Set_From_Limited_With
(Id
: E
; V
: B
:= True) is
3980 (Is_Type
(Id
) or else Ekind_In
(Id
, E_Abstract_State
, E_Package
));
3981 Set_Flag159
(Id
, V
);
3982 end Set_From_Limited_With
;
3984 procedure Set_Full_View
(Id
: E
; V
: E
) is
3986 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Constant
);
3990 procedure Set_Generic_Homonym
(Id
: E
; V
: E
) is
3993 end Set_Generic_Homonym
;
3995 procedure Set_Generic_Renamings
(Id
: E
; V
: L
) is
3997 Set_Elist23
(Id
, V
);
3998 end Set_Generic_Renamings
;
4000 procedure Set_Handler_Records
(Id
: E
; V
: S
) is
4003 end Set_Handler_Records
;
4005 procedure Set_Has_Aliased_Components
(Id
: E
; V
: B
:= True) is
4007 pragma Assert
(Id
= Base_Type
(Id
));
4008 Set_Flag135
(Id
, V
);
4009 end Set_Has_Aliased_Components
;
4011 procedure Set_Has_Alignment_Clause
(Id
: E
; V
: B
:= True) is
4014 end Set_Has_Alignment_Clause
;
4016 procedure Set_Has_All_Calls_Remote
(Id
: E
; V
: B
:= True) is
4019 end Set_Has_All_Calls_Remote
;
4021 procedure Set_Has_Anonymous_Master
(Id
: E
; V
: B
:= True) is
4024 (Ekind_In
(Id
, E_Function
, E_Package
, E_Package_Body
, E_Procedure
));
4025 Set_Flag253
(Id
, V
);
4026 end Set_Has_Anonymous_Master
;
4028 procedure Set_Has_Atomic_Components
(Id
: E
; V
: B
:= True) is
4030 pragma Assert
(not Is_Type
(Id
) or else Is_Base_Type
(Id
));
4032 end Set_Has_Atomic_Components
;
4034 procedure Set_Has_Biased_Representation
(Id
: E
; V
: B
:= True) is
4037 ((V
= False) or else (Is_Discrete_Type
(Id
) or else Is_Object
(Id
)));
4038 Set_Flag139
(Id
, V
);
4039 end Set_Has_Biased_Representation
;
4041 procedure Set_Has_Completion
(Id
: E
; V
: B
:= True) is
4044 end Set_Has_Completion
;
4046 procedure Set_Has_Completion_In_Body
(Id
: E
; V
: B
:= True) is
4048 pragma Assert
(Is_Type
(Id
));
4050 end Set_Has_Completion_In_Body
;
4052 procedure Set_Has_Complex_Representation
(Id
: E
; V
: B
:= True) is
4054 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
4055 Set_Flag140
(Id
, V
);
4056 end Set_Has_Complex_Representation
;
4058 procedure Set_Has_Component_Size_Clause
(Id
: E
; V
: B
:= True) is
4060 pragma Assert
(Ekind
(Id
) = E_Array_Type
);
4062 end Set_Has_Component_Size_Clause
;
4064 procedure Set_Has_Constrained_Partial_View
(Id
: E
; V
: B
:= True) is
4066 pragma Assert
(Is_Type
(Id
));
4067 Set_Flag187
(Id
, V
);
4068 end Set_Has_Constrained_Partial_View
;
4070 procedure Set_Has_Contiguous_Rep
(Id
: E
; V
: B
:= True) is
4072 Set_Flag181
(Id
, V
);
4073 end Set_Has_Contiguous_Rep
;
4075 procedure Set_Has_Controlled_Component
(Id
: E
; V
: B
:= True) is
4077 pragma Assert
(Id
= Base_Type
(Id
));
4079 end Set_Has_Controlled_Component
;
4081 procedure Set_Has_Controlling_Result
(Id
: E
; V
: B
:= True) is
4084 end Set_Has_Controlling_Result
;
4086 procedure Set_Has_Convention_Pragma
(Id
: E
; V
: B
:= True) is
4088 Set_Flag119
(Id
, V
);
4089 end Set_Has_Convention_Pragma
;
4091 procedure Set_Has_Default_Aspect
(Id
: E
; V
: B
:= True) is
4094 ((Is_Scalar_Type
(Id
) or else Is_Array_Type
(Id
))
4095 and then Is_Base_Type
(Id
));
4097 end Set_Has_Default_Aspect
;
4099 procedure Set_Has_Delayed_Aspects
(Id
: E
; V
: B
:= True) is
4101 pragma Assert
(Nkind
(Id
) in N_Entity
);
4102 Set_Flag200
(Id
, V
);
4103 end Set_Has_Delayed_Aspects
;
4105 procedure Set_Has_Delayed_Freeze
(Id
: E
; V
: B
:= True) is
4107 pragma Assert
(Nkind
(Id
) in N_Entity
);
4109 end Set_Has_Delayed_Freeze
;
4111 procedure Set_Has_Delayed_Rep_Aspects
(Id
: E
; V
: B
:= True) is
4113 pragma Assert
(Nkind
(Id
) in N_Entity
);
4114 Set_Flag261
(Id
, V
);
4115 end Set_Has_Delayed_Rep_Aspects
;
4117 procedure Set_Has_Discriminants
(Id
: E
; V
: B
:= True) is
4119 pragma Assert
(Nkind
(Id
) in N_Entity
);
4121 end Set_Has_Discriminants
;
4123 procedure Set_Has_Dispatch_Table
(Id
: E
; V
: B
:= True) is
4125 pragma Assert
(Ekind
(Id
) = E_Record_Type
4126 and then Is_Tagged_Type
(Id
));
4127 Set_Flag220
(Id
, V
);
4128 end Set_Has_Dispatch_Table
;
4130 procedure Set_Has_Dynamic_Predicate_Aspect
(Id
: E
; V
: B
:= True) is
4132 pragma Assert
(Is_Type
(Id
));
4133 Set_Flag258
(Id
, V
);
4134 end Set_Has_Dynamic_Predicate_Aspect
;
4136 procedure Set_Has_Enumeration_Rep_Clause
(Id
: E
; V
: B
:= True) is
4138 pragma Assert
(Is_Enumeration_Type
(Id
));
4140 end Set_Has_Enumeration_Rep_Clause
;
4142 procedure Set_Has_Exit
(Id
: E
; V
: B
:= True) is
4147 procedure Set_Has_External_Tag_Rep_Clause
(Id
: E
; V
: B
:= True) is
4149 pragma Assert
(Is_Tagged_Type
(Id
));
4150 Set_Flag110
(Id
, V
);
4151 end Set_Has_External_Tag_Rep_Clause
;
4153 procedure Set_Has_Forward_Instantiation
(Id
: E
; V
: B
:= True) is
4155 Set_Flag175
(Id
, V
);
4156 end Set_Has_Forward_Instantiation
;
4158 procedure Set_Has_Fully_Qualified_Name
(Id
: E
; V
: B
:= True) is
4160 Set_Flag173
(Id
, V
);
4161 end Set_Has_Fully_Qualified_Name
;
4163 procedure Set_Has_Gigi_Rep_Item
(Id
: E
; V
: B
:= True) is
4166 end Set_Has_Gigi_Rep_Item
;
4168 procedure Set_Has_Homonym
(Id
: E
; V
: B
:= True) is
4171 end Set_Has_Homonym
;
4173 procedure Set_Has_Implicit_Dereference
(Id
: E
; V
: B
:= True) is
4175 Set_Flag251
(Id
, V
);
4176 end Set_Has_Implicit_Dereference
;
4178 procedure Set_Has_Independent_Components
(Id
: E
; V
: B
:= True) is
4180 pragma Assert
(Is_Object
(Id
) or else Is_Type
(Id
));
4182 end Set_Has_Independent_Components
;
4184 procedure Set_Has_Inheritable_Invariants
(Id
: E
; V
: B
:= True) is
4186 pragma Assert
(Is_Type
(Id
));
4187 Set_Flag248
(Id
, V
);
4188 end Set_Has_Inheritable_Invariants
;
4190 procedure Set_Has_Initial_Value
(Id
: E
; V
: B
:= True) is
4192 pragma Assert
(Ekind_In
(Id
, E_Variable
, E_Out_Parameter
));
4193 Set_Flag219
(Id
, V
);
4194 end Set_Has_Initial_Value
;
4196 procedure Set_Has_Invariants
(Id
: E
; V
: B
:= True) is
4198 pragma Assert
(Is_Type
(Id
));
4199 Set_Flag232
(Id
, V
);
4200 end Set_Has_Invariants
;
4202 procedure Set_Has_Loop_Entry_Attributes
(Id
: E
; V
: B
:= True) is
4204 pragma Assert
(Ekind
(Id
) = E_Loop
);
4205 Set_Flag260
(Id
, V
);
4206 end Set_Has_Loop_Entry_Attributes
;
4208 procedure Set_Has_Machine_Radix_Clause
(Id
: E
; V
: B
:= True) is
4210 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
4212 end Set_Has_Machine_Radix_Clause
;
4214 procedure Set_Has_Master_Entity
(Id
: E
; V
: B
:= True) is
4217 end Set_Has_Master_Entity
;
4219 procedure Set_Has_Missing_Return
(Id
: E
; V
: B
:= True) is
4221 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Generic_Function
));
4222 Set_Flag142
(Id
, V
);
4223 end Set_Has_Missing_Return
;
4225 procedure Set_Has_Nested_Block_With_Handler
(Id
: E
; V
: B
:= True) is
4227 Set_Flag101
(Id
, V
);
4228 end Set_Has_Nested_Block_With_Handler
;
4230 procedure Set_Has_Up_Level_Access
(Id
: E
; V
: B
:= True) is
4232 pragma Assert
(Ekind_In
(Id
, E_Variable
, E_Constant
, E_Loop_Parameter
));
4233 Set_Flag215
(Id
, V
);
4234 end Set_Has_Up_Level_Access
;
4236 procedure Set_Has_Non_Standard_Rep
(Id
: E
; V
: B
:= True) is
4238 pragma Assert
(Id
= Base_Type
(Id
));
4240 end Set_Has_Non_Standard_Rep
;
4242 procedure Set_Has_Object_Size_Clause
(Id
: E
; V
: B
:= True) is
4244 pragma Assert
(Is_Type
(Id
));
4245 Set_Flag172
(Id
, V
);
4246 end Set_Has_Object_Size_Clause
;
4248 procedure Set_Has_Per_Object_Constraint
(Id
: E
; V
: B
:= True) is
4250 Set_Flag154
(Id
, V
);
4251 end Set_Has_Per_Object_Constraint
;
4253 procedure Set_Has_Postconditions
(Id
: E
; V
: B
:= True) is
4255 pragma Assert
(Is_Subprogram
(Id
));
4256 Set_Flag240
(Id
, V
);
4257 end Set_Has_Postconditions
;
4259 procedure Set_Has_Pragma_Controlled
(Id
: E
; V
: B
:= True) is
4261 pragma Assert
(Is_Access_Type
(Id
));
4262 Set_Flag27
(Base_Type
(Id
), V
);
4263 end Set_Has_Pragma_Controlled
;
4265 procedure Set_Has_Pragma_Elaborate_Body
(Id
: E
; V
: B
:= True) is
4267 Set_Flag150
(Id
, V
);
4268 end Set_Has_Pragma_Elaborate_Body
;
4270 procedure Set_Has_Pragma_Inline
(Id
: E
; V
: B
:= True) is
4272 Set_Flag157
(Id
, V
);
4273 end Set_Has_Pragma_Inline
;
4275 procedure Set_Has_Pragma_Inline_Always
(Id
: E
; V
: B
:= True) is
4277 Set_Flag230
(Id
, V
);
4278 end Set_Has_Pragma_Inline_Always
;
4280 procedure Set_Has_Pragma_No_Inline
(Id
: E
; V
: B
:= True) is
4282 Set_Flag201
(Id
, V
);
4283 end Set_Has_Pragma_No_Inline
;
4285 procedure Set_Has_Pragma_Ordered
(Id
: E
; V
: B
:= True) is
4287 pragma Assert
(Is_Enumeration_Type
(Id
));
4288 pragma Assert
(Id
= Base_Type
(Id
));
4289 Set_Flag198
(Id
, V
);
4290 end Set_Has_Pragma_Ordered
;
4292 procedure Set_Has_Pragma_Pack
(Id
: E
; V
: B
:= True) is
4294 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
4295 pragma Assert
(Id
= Base_Type
(Id
));
4296 Set_Flag121
(Id
, V
);
4297 end Set_Has_Pragma_Pack
;
4299 procedure Set_Has_Pragma_Preelab_Init
(Id
: E
; V
: B
:= True) is
4301 Set_Flag221
(Id
, V
);
4302 end Set_Has_Pragma_Preelab_Init
;
4304 procedure Set_Has_Pragma_Pure
(Id
: E
; V
: B
:= True) is
4306 Set_Flag203
(Id
, V
);
4307 end Set_Has_Pragma_Pure
;
4309 procedure Set_Has_Pragma_Pure_Function
(Id
: E
; V
: B
:= True) is
4311 Set_Flag179
(Id
, V
);
4312 end Set_Has_Pragma_Pure_Function
;
4314 procedure Set_Has_Pragma_Thread_Local_Storage
(Id
: E
; V
: B
:= True) is
4316 Set_Flag169
(Id
, V
);
4317 end Set_Has_Pragma_Thread_Local_Storage
;
4319 procedure Set_Has_Pragma_Unmodified
(Id
: E
; V
: B
:= True) is
4321 Set_Flag233
(Id
, V
);
4322 end Set_Has_Pragma_Unmodified
;
4324 procedure Set_Has_Pragma_Unreferenced
(Id
: E
; V
: B
:= True) is
4326 Set_Flag180
(Id
, V
);
4327 end Set_Has_Pragma_Unreferenced
;
4329 procedure Set_Has_Pragma_Unreferenced_Objects
(Id
: E
; V
: B
:= True) is
4331 pragma Assert
(Is_Type
(Id
));
4332 Set_Flag212
(Id
, V
);
4333 end Set_Has_Pragma_Unreferenced_Objects
;
4335 procedure Set_Has_Predicates
(Id
: E
; V
: B
:= True) is
4337 pragma Assert
(Is_Type
(Id
) or else Ekind
(Id
) = E_Void
);
4338 Set_Flag250
(Id
, V
);
4339 end Set_Has_Predicates
;
4341 procedure Set_Has_Primitive_Operations
(Id
: E
; V
: B
:= True) is
4343 pragma Assert
(Id
= Base_Type
(Id
));
4344 Set_Flag120
(Id
, V
);
4345 end Set_Has_Primitive_Operations
;
4347 procedure Set_Has_Private_Ancestor
(Id
: E
; V
: B
:= True) is
4349 pragma Assert
(Is_Type
(Id
));
4350 Set_Flag151
(Id
, V
);
4351 end Set_Has_Private_Ancestor
;
4353 procedure Set_Has_Private_Declaration
(Id
: E
; V
: B
:= True) is
4355 Set_Flag155
(Id
, V
);
4356 end Set_Has_Private_Declaration
;
4358 procedure Set_Has_Qualified_Name
(Id
: E
; V
: B
:= True) is
4360 Set_Flag161
(Id
, V
);
4361 end Set_Has_Qualified_Name
;
4363 procedure Set_Has_RACW
(Id
: E
; V
: B
:= True) is
4365 pragma Assert
(Ekind
(Id
) = E_Package
);
4366 Set_Flag214
(Id
, V
);
4369 procedure Set_Has_Record_Rep_Clause
(Id
: E
; V
: B
:= True) is
4371 pragma Assert
(Id
= Base_Type
(Id
));
4373 end Set_Has_Record_Rep_Clause
;
4375 procedure Set_Has_Recursive_Call
(Id
: E
; V
: B
:= True) is
4377 pragma Assert
(Is_Subprogram
(Id
));
4378 Set_Flag143
(Id
, V
);
4379 end Set_Has_Recursive_Call
;
4381 procedure Set_Has_Shift_Operator
(Id
: E
; V
: B
:= True) is
4383 pragma Assert
(Is_Integer_Type
(Id
) and then Is_Base_Type
(Id
));
4384 Set_Flag267
(Id
, V
);
4385 end Set_Has_Shift_Operator
;
4387 procedure Set_Has_Size_Clause
(Id
: E
; V
: B
:= True) is
4390 end Set_Has_Size_Clause
;
4392 procedure Set_Has_Small_Clause
(Id
: E
; V
: B
:= True) is
4395 end Set_Has_Small_Clause
;
4397 procedure Set_Has_Specified_Layout
(Id
: E
; V
: B
:= True) is
4399 pragma Assert
(Id
= Base_Type
(Id
));
4400 Set_Flag100
(Id
, V
);
4401 end Set_Has_Specified_Layout
;
4403 procedure Set_Has_Specified_Stream_Input
(Id
: E
; V
: B
:= True) is
4405 pragma Assert
(Is_Type
(Id
));
4406 Set_Flag190
(Id
, V
);
4407 end Set_Has_Specified_Stream_Input
;
4409 procedure Set_Has_Specified_Stream_Output
(Id
: E
; V
: B
:= True) is
4411 pragma Assert
(Is_Type
(Id
));
4412 Set_Flag191
(Id
, V
);
4413 end Set_Has_Specified_Stream_Output
;
4415 procedure Set_Has_Specified_Stream_Read
(Id
: E
; V
: B
:= True) is
4417 pragma Assert
(Is_Type
(Id
));
4418 Set_Flag192
(Id
, V
);
4419 end Set_Has_Specified_Stream_Read
;
4421 procedure Set_Has_Specified_Stream_Write
(Id
: E
; V
: B
:= True) is
4423 pragma Assert
(Is_Type
(Id
));
4424 Set_Flag193
(Id
, V
);
4425 end Set_Has_Specified_Stream_Write
;
4427 procedure Set_Has_Static_Discriminants
(Id
: E
; V
: B
:= True) is
4429 Set_Flag211
(Id
, V
);
4430 end Set_Has_Static_Discriminants
;
4432 procedure Set_Has_Static_Predicate_Aspect
(Id
: E
; V
: B
:= True) is
4434 pragma Assert
(Is_Type
(Id
));
4435 Set_Flag259
(Id
, V
);
4436 end Set_Has_Static_Predicate_Aspect
;
4438 procedure Set_Has_Storage_Size_Clause
(Id
: E
; V
: B
:= True) is
4440 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
4441 pragma Assert
(Id
= Base_Type
(Id
));
4443 end Set_Has_Storage_Size_Clause
;
4445 procedure Set_Has_Stream_Size_Clause
(Id
: E
; V
: B
:= True) is
4447 pragma Assert
(Is_Elementary_Type
(Id
));
4448 Set_Flag184
(Id
, V
);
4449 end Set_Has_Stream_Size_Clause
;
4451 procedure Set_Has_Task
(Id
: E
; V
: B
:= True) is
4453 pragma Assert
(Id
= Base_Type
(Id
));
4457 procedure Set_Has_Thunks
(Id
: E
; V
: B
:= True) is
4459 pragma Assert
(Is_Tag
(Id
));
4460 Set_Flag228
(Id
, V
);
4463 procedure Set_Has_Unchecked_Union
(Id
: E
; V
: B
:= True) is
4465 pragma Assert
(Id
= Base_Type
(Id
));
4466 Set_Flag123
(Id
, V
);
4467 end Set_Has_Unchecked_Union
;
4469 procedure Set_Has_Unknown_Discriminants
(Id
: E
; V
: B
:= True) is
4471 pragma Assert
(Is_Type
(Id
));
4473 end Set_Has_Unknown_Discriminants
;
4475 procedure Set_Has_Visible_Refinement
(Id
: E
; V
: B
:= True) is
4477 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
4478 Set_Flag263
(Id
, V
);
4479 end Set_Has_Visible_Refinement
;
4481 procedure Set_Has_Volatile_Components
(Id
: E
; V
: B
:= True) is
4483 pragma Assert
(not Is_Type
(Id
) or else Is_Base_Type
(Id
));
4485 end Set_Has_Volatile_Components
;
4487 procedure Set_Has_Xref_Entry
(Id
: E
; V
: B
:= True) is
4489 Set_Flag182
(Id
, V
);
4490 end Set_Has_Xref_Entry
;
4492 procedure Set_Hiding_Loop_Variable
(Id
: E
; V
: E
) is
4494 pragma Assert
(Ekind
(Id
) = E_Variable
);
4496 end Set_Hiding_Loop_Variable
;
4498 procedure Set_Homonym
(Id
: E
; V
: E
) is
4500 pragma Assert
(Id
/= V
);
4504 procedure Set_Import_Pragma
(Id
: E
; V
: E
) is
4506 pragma Assert
(Is_Subprogram
(Id
));
4508 end Set_Import_Pragma
;
4510 procedure Set_Interface_Alias
(Id
: E
; V
: E
) is
4514 and then Is_Hidden
(Id
)
4515 and then (Ekind_In
(Id
, E_Procedure
, E_Function
)));
4517 end Set_Interface_Alias
;
4519 procedure Set_Interfaces
(Id
: E
; V
: L
) is
4521 pragma Assert
(Is_Record_Type
(Id
));
4522 Set_Elist25
(Id
, V
);
4525 procedure Set_In_Package_Body
(Id
: E
; V
: B
:= True) is
4528 end Set_In_Package_Body
;
4530 procedure Set_In_Private_Part
(Id
: E
; V
: B
:= True) is
4533 end Set_In_Private_Part
;
4535 procedure Set_In_Use
(Id
: E
; V
: B
:= True) is
4537 pragma Assert
(Nkind
(Id
) in N_Entity
);
4541 procedure Set_Initialization_Statements
(Id
: E
; V
: N
) is
4543 -- Tolerate an E_Void entity since this can be called while resolving
4544 -- an aggregate used as the initialization expression for an object
4545 -- declaration, and this occurs before the Ekind for the object is set.
4547 pragma Assert
(Ekind_In
(Id
, E_Void
, E_Constant
, E_Variable
));
4549 end Set_Initialization_Statements
;
4551 procedure Set_Inner_Instances
(Id
: E
; V
: L
) is
4553 Set_Elist23
(Id
, V
);
4554 end Set_Inner_Instances
;
4556 procedure Set_Interface_Name
(Id
: E
; V
: N
) is
4559 end Set_Interface_Name
;
4561 procedure Set_Is_Abstract_Subprogram
(Id
: E
; V
: B
:= True) is
4563 pragma Assert
(Is_Overloadable
(Id
));
4565 end Set_Is_Abstract_Subprogram
;
4567 procedure Set_Is_Abstract_Type
(Id
: E
; V
: B
:= True) is
4569 pragma Assert
(Is_Type
(Id
));
4570 Set_Flag146
(Id
, V
);
4571 end Set_Is_Abstract_Type
;
4573 procedure Set_Is_Local_Anonymous_Access
(Id
: E
; V
: B
:= True) is
4575 pragma Assert
(Is_Access_Type
(Id
));
4576 Set_Flag194
(Id
, V
);
4577 end Set_Is_Local_Anonymous_Access
;
4579 procedure Set_Is_Access_Constant
(Id
: E
; V
: B
:= True) is
4581 pragma Assert
(Is_Access_Type
(Id
));
4583 end Set_Is_Access_Constant
;
4585 procedure Set_Is_Ada_2005_Only
(Id
: E
; V
: B
:= True) is
4587 Set_Flag185
(Id
, V
);
4588 end Set_Is_Ada_2005_Only
;
4590 procedure Set_Is_Ada_2012_Only
(Id
: E
; V
: B
:= True) is
4592 Set_Flag199
(Id
, V
);
4593 end Set_Is_Ada_2012_Only
;
4595 procedure Set_Is_Aliased
(Id
: E
; V
: B
:= True) is
4597 pragma Assert
(Nkind
(Id
) in N_Entity
);
4601 procedure Set_Is_AST_Entry
(Id
: E
; V
: B
:= True) is
4603 pragma Assert
(Is_Entry
(Id
));
4604 Set_Flag132
(Id
, V
);
4605 end Set_Is_AST_Entry
;
4607 procedure Set_Is_Asynchronous
(Id
: E
; V
: B
:= True) is
4610 (Ekind
(Id
) = E_Procedure
or else Is_Type
(Id
));
4612 end Set_Is_Asynchronous
;
4614 procedure Set_Is_Atomic
(Id
: E
; V
: B
:= True) is
4619 procedure Set_Is_Bit_Packed_Array
(Id
: E
; V
: B
:= True) is
4621 pragma Assert
((not V
)
4622 or else (Is_Array_Type
(Id
) and then Is_Base_Type
(Id
)));
4623 Set_Flag122
(Id
, V
);
4624 end Set_Is_Bit_Packed_Array
;
4626 procedure Set_Is_Called
(Id
: E
; V
: B
:= True) is
4628 pragma Assert
(Ekind_In
(Id
, E_Procedure
, E_Function
));
4629 Set_Flag102
(Id
, V
);
4632 procedure Set_Is_Character_Type
(Id
: E
; V
: B
:= True) is
4635 end Set_Is_Character_Type
;
4637 procedure Set_Is_Child_Unit
(Id
: E
; V
: B
:= True) is
4640 end Set_Is_Child_Unit
;
4642 procedure Set_Is_Class_Wide_Equivalent_Type
(Id
: E
; V
: B
:= True) is
4645 end Set_Is_Class_Wide_Equivalent_Type
;
4647 procedure Set_Is_Compilation_Unit
(Id
: E
; V
: B
:= True) is
4649 Set_Flag149
(Id
, V
);
4650 end Set_Is_Compilation_Unit
;
4652 procedure Set_Is_Completely_Hidden
(Id
: E
; V
: B
:= True) is
4654 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
4655 Set_Flag103
(Id
, V
);
4656 end Set_Is_Completely_Hidden
;
4658 procedure Set_Is_Concurrent_Record_Type
(Id
: E
; V
: B
:= True) is
4661 end Set_Is_Concurrent_Record_Type
;
4663 procedure Set_Is_Constr_Subt_For_U_Nominal
(Id
: E
; V
: B
:= True) is
4666 end Set_Is_Constr_Subt_For_U_Nominal
;
4668 procedure Set_Is_Constr_Subt_For_UN_Aliased
(Id
: E
; V
: B
:= True) is
4670 Set_Flag141
(Id
, V
);
4671 end Set_Is_Constr_Subt_For_UN_Aliased
;
4673 procedure Set_Is_Constrained
(Id
: E
; V
: B
:= True) is
4675 pragma Assert
(Nkind
(Id
) in N_Entity
);
4677 end Set_Is_Constrained
;
4679 procedure Set_Is_Constructor
(Id
: E
; V
: B
:= True) is
4682 end Set_Is_Constructor
;
4684 procedure Set_Is_Controlled
(Id
: E
; V
: B
:= True) is
4686 pragma Assert
(Id
= Base_Type
(Id
));
4688 end Set_Is_Controlled
;
4690 procedure Set_Is_Controlling_Formal
(Id
: E
; V
: B
:= True) is
4692 pragma Assert
(Is_Formal
(Id
));
4694 end Set_Is_Controlling_Formal
;
4696 procedure Set_Is_CPP_Class
(Id
: E
; V
: B
:= True) is
4699 end Set_Is_CPP_Class
;
4701 procedure Set_Is_Descendent_Of_Address
(Id
: E
; V
: B
:= True) is
4703 pragma Assert
(Is_Type
(Id
));
4704 Set_Flag223
(Id
, V
);
4705 end Set_Is_Descendent_Of_Address
;
4707 procedure Set_Is_Discrim_SO_Function
(Id
: E
; V
: B
:= True) is
4709 Set_Flag176
(Id
, V
);
4710 end Set_Is_Discrim_SO_Function
;
4712 procedure Set_Is_Discriminant_Check_Function
(Id
: E
; V
: B
:= True) is
4714 Set_Flag264
(Id
, V
);
4715 end Set_Is_Discriminant_Check_Function
;
4717 procedure Set_Is_Dispatch_Table_Entity
(Id
: E
; V
: B
:= True) is
4719 Set_Flag234
(Id
, V
);
4720 end Set_Is_Dispatch_Table_Entity
;
4722 procedure Set_Is_Dispatching_Operation
(Id
: E
; V
: B
:= True) is
4727 Is_Overloadable
(Id
)
4729 Ekind
(Id
) = E_Subprogram_Type
);
4732 end Set_Is_Dispatching_Operation
;
4734 procedure Set_Is_Eliminated
(Id
: E
; V
: B
:= True) is
4736 Set_Flag124
(Id
, V
);
4737 end Set_Is_Eliminated
;
4739 procedure Set_Is_Entry_Formal
(Id
: E
; V
: B
:= True) is
4742 end Set_Is_Entry_Formal
;
4744 procedure Set_Is_Exported
(Id
: E
; V
: B
:= True) is
4747 end Set_Is_Exported
;
4749 procedure Set_Is_First_Subtype
(Id
: E
; V
: B
:= True) is
4752 end Set_Is_First_Subtype
;
4754 procedure Set_Is_For_Access_Subtype
(Id
: E
; V
: B
:= True) is
4756 pragma Assert
(Ekind_In
(Id
, E_Record_Subtype
, E_Private_Subtype
));
4757 Set_Flag118
(Id
, V
);
4758 end Set_Is_For_Access_Subtype
;
4760 procedure Set_Is_Formal_Subprogram
(Id
: E
; V
: B
:= True) is
4762 Set_Flag111
(Id
, V
);
4763 end Set_Is_Formal_Subprogram
;
4765 procedure Set_Is_Frozen
(Id
: E
; V
: B
:= True) is
4767 pragma Assert
(Nkind
(Id
) in N_Entity
);
4771 procedure Set_Is_Generic_Actual_Type
(Id
: E
; V
: B
:= True) is
4773 pragma Assert
(Is_Type
(Id
));
4775 end Set_Is_Generic_Actual_Type
;
4777 procedure Set_Is_Generic_Instance
(Id
: E
; V
: B
:= True) is
4779 Set_Flag130
(Id
, V
);
4780 end Set_Is_Generic_Instance
;
4782 procedure Set_Is_Generic_Type
(Id
: E
; V
: B
:= True) is
4784 pragma Assert
(Nkind
(Id
) in N_Entity
);
4786 end Set_Is_Generic_Type
;
4788 procedure Set_Is_Hidden
(Id
: E
; V
: B
:= True) is
4793 procedure Set_Is_Hidden_Open_Scope
(Id
: E
; V
: B
:= True) is
4795 Set_Flag171
(Id
, V
);
4796 end Set_Is_Hidden_Open_Scope
;
4798 procedure Set_Is_Immediately_Visible
(Id
: E
; V
: B
:= True) is
4800 pragma Assert
(Nkind
(Id
) in N_Entity
);
4802 end Set_Is_Immediately_Visible
;
4804 procedure Set_Is_Implementation_Defined
(Id
: E
; V
: B
:= True) is
4806 Set_Flag254
(Id
, V
);
4807 end Set_Is_Implementation_Defined
;
4809 procedure Set_Is_Imported
(Id
: E
; V
: B
:= True) is
4812 end Set_Is_Imported
;
4814 procedure Set_Is_Inlined
(Id
: E
; V
: B
:= True) is
4819 procedure Set_Is_Interface
(Id
: E
; V
: B
:= True) is
4821 pragma Assert
(Is_Record_Type
(Id
));
4822 Set_Flag186
(Id
, V
);
4823 end Set_Is_Interface
;
4825 procedure Set_Is_Instantiated
(Id
: E
; V
: B
:= True) is
4827 Set_Flag126
(Id
, V
);
4828 end Set_Is_Instantiated
;
4830 procedure Set_Is_Internal
(Id
: E
; V
: B
:= True) is
4832 pragma Assert
(Nkind
(Id
) in N_Entity
);
4834 end Set_Is_Internal
;
4836 procedure Set_Is_Interrupt_Handler
(Id
: E
; V
: B
:= True) is
4838 pragma Assert
(Nkind
(Id
) in N_Entity
);
4840 end Set_Is_Interrupt_Handler
;
4842 procedure Set_Is_Intrinsic_Subprogram
(Id
: E
; V
: B
:= True) is
4845 end Set_Is_Intrinsic_Subprogram
;
4847 procedure Set_Is_Invariant_Procedure
(Id
: E
; V
: B
:= True) is
4849 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
4850 Set_Flag257
(Id
, V
);
4851 end Set_Is_Invariant_Procedure
;
4853 procedure Set_Is_Itype
(Id
: E
; V
: B
:= True) is
4858 procedure Set_Is_Known_Non_Null
(Id
: E
; V
: B
:= True) is
4861 end Set_Is_Known_Non_Null
;
4863 procedure Set_Is_Known_Null
(Id
: E
; V
: B
:= True) is
4865 Set_Flag204
(Id
, V
);
4866 end Set_Is_Known_Null
;
4868 procedure Set_Is_Known_Valid
(Id
: E
; V
: B
:= True) is
4870 Set_Flag170
(Id
, V
);
4871 end Set_Is_Known_Valid
;
4873 procedure Set_Is_Limited_Composite
(Id
: E
; V
: B
:= True) is
4875 pragma Assert
(Is_Type
(Id
));
4876 Set_Flag106
(Id
, V
);
4877 end Set_Is_Limited_Composite
;
4879 procedure Set_Is_Limited_Interface
(Id
: E
; V
: B
:= True) is
4881 pragma Assert
(Is_Interface
(Id
));
4882 Set_Flag197
(Id
, V
);
4883 end Set_Is_Limited_Interface
;
4885 procedure Set_Is_Limited_Record
(Id
: E
; V
: B
:= True) is
4888 end Set_Is_Limited_Record
;
4890 procedure Set_Is_Machine_Code_Subprogram
(Id
: E
; V
: B
:= True) is
4892 pragma Assert
(Is_Subprogram
(Id
));
4893 Set_Flag137
(Id
, V
);
4894 end Set_Is_Machine_Code_Subprogram
;
4896 procedure Set_Is_Non_Static_Subtype
(Id
: E
; V
: B
:= True) is
4898 pragma Assert
(Is_Type
(Id
));
4899 Set_Flag109
(Id
, V
);
4900 end Set_Is_Non_Static_Subtype
;
4902 procedure Set_Is_Null_Init_Proc
(Id
: E
; V
: B
:= True) is
4904 pragma Assert
(Ekind
(Id
) = E_Procedure
);
4905 Set_Flag178
(Id
, V
);
4906 end Set_Is_Null_Init_Proc
;
4908 procedure Set_Is_Obsolescent
(Id
: E
; V
: B
:= True) is
4910 Set_Flag153
(Id
, V
);
4911 end Set_Is_Obsolescent
;
4913 procedure Set_Is_Only_Out_Parameter
(Id
: E
; V
: B
:= True) is
4915 pragma Assert
(Ekind
(Id
) = E_Out_Parameter
);
4916 Set_Flag226
(Id
, V
);
4917 end Set_Is_Only_Out_Parameter
;
4919 procedure Set_Is_Optional_Parameter
(Id
: E
; V
: B
:= True) is
4921 pragma Assert
(Is_Formal
(Id
));
4922 Set_Flag134
(Id
, V
);
4923 end Set_Is_Optional_Parameter
;
4925 procedure Set_Is_Package_Body_Entity
(Id
: E
; V
: B
:= True) is
4927 Set_Flag160
(Id
, V
);
4928 end Set_Is_Package_Body_Entity
;
4930 procedure Set_Is_Packed
(Id
: E
; V
: B
:= True) is
4932 pragma Assert
(Id
= Base_Type
(Id
));
4936 procedure Set_Is_Packed_Array_Type
(Id
: E
; V
: B
:= True) is
4938 Set_Flag138
(Id
, V
);
4939 end Set_Is_Packed_Array_Type
;
4941 procedure Set_Is_Potentially_Use_Visible
(Id
: E
; V
: B
:= True) is
4943 pragma Assert
(Nkind
(Id
) in N_Entity
);
4945 end Set_Is_Potentially_Use_Visible
;
4947 procedure Set_Is_Predicate_Function
(Id
: E
; V
: B
:= True) is
4949 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
4950 Set_Flag255
(Id
, V
);
4951 end Set_Is_Predicate_Function
;
4953 procedure Set_Is_Predicate_Function_M
(Id
: E
; V
: B
:= True) is
4955 pragma Assert
(Ekind
(Id
) = E_Function
or else Ekind
(Id
) = E_Procedure
);
4956 Set_Flag256
(Id
, V
);
4957 end Set_Is_Predicate_Function_M
;
4959 procedure Set_Is_Preelaborated
(Id
: E
; V
: B
:= True) is
4962 end Set_Is_Preelaborated
;
4964 procedure Set_Is_Primitive
(Id
: E
; V
: B
:= True) is
4967 (Is_Overloadable
(Id
)
4968 or else Ekind_In
(Id
, E_Generic_Function
, E_Generic_Procedure
));
4969 Set_Flag218
(Id
, V
);
4970 end Set_Is_Primitive
;
4972 procedure Set_Is_Primitive_Wrapper
(Id
: E
; V
: B
:= True) is
4974 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
4975 Set_Flag195
(Id
, V
);
4976 end Set_Is_Primitive_Wrapper
;
4978 procedure Set_Is_Private_Composite
(Id
: E
; V
: B
:= True) is
4980 pragma Assert
(Is_Type
(Id
));
4981 Set_Flag107
(Id
, V
);
4982 end Set_Is_Private_Composite
;
4984 procedure Set_Is_Private_Descendant
(Id
: E
; V
: B
:= True) is
4987 end Set_Is_Private_Descendant
;
4989 procedure Set_Is_Private_Primitive
(Id
: E
; V
: B
:= True) is
4991 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
));
4992 Set_Flag245
(Id
, V
);
4993 end Set_Is_Private_Primitive
;
4995 procedure Set_Is_Processed_Transient
(Id
: E
; V
: B
:= True) is
4997 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
4998 Set_Flag252
(Id
, V
);
4999 end Set_Is_Processed_Transient
;
5001 procedure Set_Is_Public
(Id
: E
; V
: B
:= True) is
5003 pragma Assert
(Nkind
(Id
) in N_Entity
);
5007 procedure Set_Is_Pure
(Id
: E
; V
: B
:= True) is
5012 procedure Set_Is_Pure_Unit_Access_Type
(Id
: E
; V
: B
:= True) is
5014 pragma Assert
(Is_Access_Type
(Id
));
5015 Set_Flag189
(Id
, V
);
5016 end Set_Is_Pure_Unit_Access_Type
;
5018 procedure Set_Is_RACW_Stub_Type
(Id
: E
; V
: B
:= True) is
5020 pragma Assert
(Is_Type
(Id
));
5021 Set_Flag244
(Id
, V
);
5022 end Set_Is_RACW_Stub_Type
;
5024 procedure Set_Is_Raised
(Id
: E
; V
: B
:= True) is
5026 pragma Assert
(Ekind
(Id
) = E_Exception
);
5027 Set_Flag224
(Id
, V
);
5030 procedure Set_Is_Remote_Call_Interface
(Id
: E
; V
: B
:= True) is
5033 end Set_Is_Remote_Call_Interface
;
5035 procedure Set_Is_Remote_Types
(Id
: E
; V
: B
:= True) is
5038 end Set_Is_Remote_Types
;
5040 procedure Set_Is_Renaming_Of_Object
(Id
: E
; V
: B
:= True) is
5042 Set_Flag112
(Id
, V
);
5043 end Set_Is_Renaming_Of_Object
;
5045 procedure Set_Is_Return_Object
(Id
: E
; V
: B
:= True) is
5047 Set_Flag209
(Id
, V
);
5048 end Set_Is_Return_Object
;
5050 procedure Set_Is_Safe_To_Reevaluate
(Id
: E
; V
: B
:= True) is
5052 pragma Assert
(Ekind
(Id
) = E_Variable
);
5053 Set_Flag249
(Id
, V
);
5054 end Set_Is_Safe_To_Reevaluate
;
5056 procedure Set_Is_Shared_Passive
(Id
: E
; V
: B
:= True) is
5059 end Set_Is_Shared_Passive
;
5061 procedure Set_Is_Statically_Allocated
(Id
: E
; V
: B
:= True) is
5065 or else Ekind_In
(Id
, E_Exception
,
5070 end Set_Is_Statically_Allocated
;
5072 procedure Set_Is_Tag
(Id
: E
; V
: B
:= True) is
5074 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Constant
, E_Variable
));
5078 procedure Set_Is_Tagged_Type
(Id
: E
; V
: B
:= True) is
5081 end Set_Is_Tagged_Type
;
5083 procedure Set_Is_Thunk
(Id
: E
; V
: B
:= True) is
5085 pragma Assert
(Is_Subprogram
(Id
));
5086 Set_Flag225
(Id
, V
);
5089 procedure Set_Is_Trivial_Subprogram
(Id
: E
; V
: B
:= True) is
5091 Set_Flag235
(Id
, V
);
5092 end Set_Is_Trivial_Subprogram
;
5094 procedure Set_Is_True_Constant
(Id
: E
; V
: B
:= True) is
5096 Set_Flag163
(Id
, V
);
5097 end Set_Is_True_Constant
;
5099 procedure Set_Is_Unchecked_Union
(Id
: E
; V
: B
:= True) is
5101 pragma Assert
(Id
= Base_Type
(Id
));
5102 Set_Flag117
(Id
, V
);
5103 end Set_Is_Unchecked_Union
;
5105 procedure Set_Is_Underlying_Record_View
(Id
: E
; V
: B
:= True) is
5107 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
5108 Set_Flag246
(Id
, V
);
5109 end Set_Is_Underlying_Record_View
;
5111 procedure Set_Is_Unsigned_Type
(Id
: E
; V
: B
:= True) is
5113 pragma Assert
(Is_Discrete_Or_Fixed_Point_Type
(Id
));
5114 Set_Flag144
(Id
, V
);
5115 end Set_Is_Unsigned_Type
;
5117 procedure Set_Is_Valued_Procedure
(Id
: E
; V
: B
:= True) is
5119 pragma Assert
(Ekind
(Id
) = E_Procedure
);
5120 Set_Flag127
(Id
, V
);
5121 end Set_Is_Valued_Procedure
;
5123 procedure Set_Is_Visible_Formal
(Id
: E
; V
: B
:= True) is
5125 Set_Flag206
(Id
, V
);
5126 end Set_Is_Visible_Formal
;
5128 procedure Set_Is_Visible_Lib_Unit
(Id
: E
; V
: B
:= True) is
5130 Set_Flag116
(Id
, V
);
5131 end Set_Is_Visible_Lib_Unit
;
5133 procedure Set_Is_VMS_Exception
(Id
: E
; V
: B
:= True) is
5135 pragma Assert
(Ekind
(Id
) = E_Exception
);
5136 Set_Flag133
(Id
, V
);
5137 end Set_Is_VMS_Exception
;
5139 procedure Set_Is_Volatile
(Id
: E
; V
: B
:= True) is
5141 pragma Assert
(Nkind
(Id
) in N_Entity
);
5143 end Set_Is_Volatile
;
5145 procedure Set_Itype_Printed
(Id
: E
; V
: B
:= True) is
5147 pragma Assert
(Is_Itype
(Id
));
5148 Set_Flag202
(Id
, V
);
5149 end Set_Itype_Printed
;
5151 procedure Set_Kill_Elaboration_Checks
(Id
: E
; V
: B
:= True) is
5154 end Set_Kill_Elaboration_Checks
;
5156 procedure Set_Kill_Range_Checks
(Id
: E
; V
: B
:= True) is
5159 end Set_Kill_Range_Checks
;
5161 procedure Set_Known_To_Have_Preelab_Init
(Id
: E
; V
: B
:= True) is
5163 pragma Assert
(Is_Type
(Id
));
5164 Set_Flag207
(Id
, V
);
5165 end Set_Known_To_Have_Preelab_Init
;
5167 procedure Set_Last_Aggregate_Assignment
(Id
: E
; V
: N
) is
5169 pragma Assert
(Ekind
(Id
) = E_Variable
);
5171 end Set_Last_Aggregate_Assignment
;
5173 procedure Set_Last_Assignment
(Id
: E
; V
: N
) is
5175 pragma Assert
(Is_Assignable
(Id
));
5177 end Set_Last_Assignment
;
5179 procedure Set_Last_Entity
(Id
: E
; V
: E
) is
5182 end Set_Last_Entity
;
5184 procedure Set_Limited_View
(Id
: E
; V
: E
) is
5186 pragma Assert
(Ekind
(Id
) = E_Package
);
5188 end Set_Limited_View
;
5190 procedure Set_Linker_Section_Pragma
(Id
: E
; V
: N
) is
5192 pragma Assert
(Is_Type
(Id
)
5193 or else Ekind_In
(Id
, E_Constant
, E_Variable
)
5194 or else Is_Subprogram
(Id
));
5196 end Set_Linker_Section_Pragma
;
5198 procedure Set_Lit_Indexes
(Id
: E
; V
: E
) is
5200 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
5202 end Set_Lit_Indexes
;
5204 procedure Set_Lit_Strings
(Id
: E
; V
: E
) is
5206 pragma Assert
(Is_Enumeration_Type
(Id
) and then Root_Type
(Id
) = Id
);
5208 end Set_Lit_Strings
;
5210 procedure Set_Low_Bound_Tested
(Id
: E
; V
: B
:= True) is
5212 pragma Assert
(Is_Formal
(Id
));
5213 Set_Flag205
(Id
, V
);
5214 end Set_Low_Bound_Tested
;
5216 procedure Set_Machine_Radix_10
(Id
: E
; V
: B
:= True) is
5218 pragma Assert
(Is_Decimal_Fixed_Point_Type
(Id
));
5220 end Set_Machine_Radix_10
;
5222 procedure Set_Master_Id
(Id
: E
; V
: E
) is
5224 pragma Assert
(Is_Access_Type
(Id
));
5228 procedure Set_Materialize_Entity
(Id
: E
; V
: B
:= True) is
5230 Set_Flag168
(Id
, V
);
5231 end Set_Materialize_Entity
;
5233 procedure Set_May_Inherit_Delayed_Rep_Aspects
(Id
: E
; V
: B
:= True) is
5235 Set_Flag262
(Id
, V
);
5236 end Set_May_Inherit_Delayed_Rep_Aspects
;
5238 procedure Set_Mechanism
(Id
: E
; V
: M
) is
5240 pragma Assert
(Ekind
(Id
) = E_Function
or else Is_Formal
(Id
));
5241 Set_Uint8
(Id
, UI_From_Int
(V
));
5244 procedure Set_Modulus
(Id
: E
; V
: U
) is
5246 pragma Assert
(Ekind
(Id
) = E_Modular_Integer_Type
);
5250 procedure Set_Must_Be_On_Byte_Boundary
(Id
: E
; V
: B
:= True) is
5252 pragma Assert
(Is_Type
(Id
));
5253 Set_Flag183
(Id
, V
);
5254 end Set_Must_Be_On_Byte_Boundary
;
5256 procedure Set_Must_Have_Preelab_Init
(Id
: E
; V
: B
:= True) is
5258 pragma Assert
(Is_Type
(Id
));
5259 Set_Flag208
(Id
, V
);
5260 end Set_Must_Have_Preelab_Init
;
5262 procedure Set_Needs_Debug_Info
(Id
: E
; V
: B
:= True) is
5264 Set_Flag147
(Id
, V
);
5265 end Set_Needs_Debug_Info
;
5267 procedure Set_Needs_No_Actuals
(Id
: E
; V
: B
:= True) is
5270 (Is_Overloadable
(Id
)
5271 or else Ekind_In
(Id
, E_Subprogram_Type
, E_Entry_Family
));
5273 end Set_Needs_No_Actuals
;
5275 procedure Set_Never_Set_In_Source
(Id
: E
; V
: B
:= True) is
5277 Set_Flag115
(Id
, V
);
5278 end Set_Never_Set_In_Source
;
5280 procedure Set_Next_Inlined_Subprogram
(Id
: E
; V
: E
) is
5283 end Set_Next_Inlined_Subprogram
;
5285 procedure Set_No_Pool_Assigned
(Id
: E
; V
: B
:= True) is
5287 pragma Assert
(Is_Access_Type
(Id
) and then Is_Base_Type
(Id
));
5288 Set_Flag131
(Id
, V
);
5289 end Set_No_Pool_Assigned
;
5291 procedure Set_No_Return
(Id
: E
; V
: B
:= True) is
5294 (V
= False or else Ekind_In
(Id
, E_Procedure
, E_Generic_Procedure
));
5295 Set_Flag113
(Id
, V
);
5298 procedure Set_No_Strict_Aliasing
(Id
: E
; V
: B
:= True) is
5300 pragma Assert
(Is_Access_Type
(Id
) and then Is_Base_Type
(Id
));
5301 Set_Flag136
(Id
, V
);
5302 end Set_No_Strict_Aliasing
;
5304 procedure Set_Non_Binary_Modulus
(Id
: E
; V
: B
:= True) is
5306 pragma Assert
(Is_Type
(Id
) and then Is_Base_Type
(Id
));
5308 end Set_Non_Binary_Modulus
;
5310 procedure Set_Non_Limited_View
(Id
: E
; V
: E
) is
5313 (Ekind
(Id
) in Incomplete_Kind
or else Ekind
(Id
) = E_Abstract_State
);
5315 end Set_Non_Limited_View
;
5317 procedure Set_Nonzero_Is_True
(Id
: E
; V
: B
:= True) is
5320 (Root_Type
(Id
) = Standard_Boolean
5321 and then Ekind
(Id
) = E_Enumeration_Type
);
5322 Set_Flag162
(Id
, V
);
5323 end Set_Nonzero_Is_True
;
5325 procedure Set_Normalized_First_Bit
(Id
: E
; V
: U
) is
5327 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
5329 end Set_Normalized_First_Bit
;
5331 procedure Set_Normalized_Position
(Id
: E
; V
: U
) is
5333 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
5335 end Set_Normalized_Position
;
5337 procedure Set_Normalized_Position_Max
(Id
: E
; V
: U
) is
5339 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Discriminant
));
5341 end Set_Normalized_Position_Max
;
5343 procedure Set_OK_To_Rename
(Id
: E
; V
: B
:= True) is
5345 pragma Assert
(Ekind
(Id
) = E_Variable
);
5346 Set_Flag247
(Id
, V
);
5347 end Set_OK_To_Rename
;
5349 procedure Set_OK_To_Reorder_Components
(Id
: E
; V
: B
:= True) is
5352 (Is_Record_Type
(Id
) and then Is_Base_Type
(Id
));
5353 Set_Flag239
(Id
, V
);
5354 end Set_OK_To_Reorder_Components
;
5356 procedure Set_Optimize_Alignment_Space
(Id
: E
; V
: B
:= True) is
5359 (Is_Type
(Id
) or else Ekind_In
(Id
, E_Constant
, E_Variable
));
5360 Set_Flag241
(Id
, V
);
5361 end Set_Optimize_Alignment_Space
;
5363 procedure Set_Optimize_Alignment_Time
(Id
: E
; V
: B
:= True) is
5366 (Is_Type
(Id
) or else Ekind_In
(Id
, E_Constant
, E_Variable
));
5367 Set_Flag242
(Id
, V
);
5368 end Set_Optimize_Alignment_Time
;
5370 procedure Set_Original_Access_Type
(Id
: E
; V
: E
) is
5372 pragma Assert
(Ekind
(Id
) = E_Access_Subprogram_Type
);
5374 end Set_Original_Access_Type
;
5376 procedure Set_Original_Array_Type
(Id
: E
; V
: E
) is
5378 pragma Assert
(Is_Array_Type
(Id
) or else Is_Modular_Integer_Type
(Id
));
5380 end Set_Original_Array_Type
;
5382 procedure Set_Original_Record_Component
(Id
: E
; V
: E
) is
5384 pragma Assert
(Ekind_In
(Id
, E_Void
, E_Component
, E_Discriminant
));
5386 end Set_Original_Record_Component
;
5388 procedure Set_Overlays_Constant
(Id
: E
; V
: B
:= True) is
5390 Set_Flag243
(Id
, V
);
5391 end Set_Overlays_Constant
;
5393 procedure Set_Overridden_Operation
(Id
: E
; V
: E
) is
5396 end Set_Overridden_Operation
;
5398 procedure Set_Package_Instantiation
(Id
: E
; V
: N
) is
5400 pragma Assert
(Ekind_In
(Id
, E_Void
, E_Generic_Package
, E_Package
));
5402 end Set_Package_Instantiation
;
5404 procedure Set_Packed_Array_Type
(Id
: E
; V
: E
) is
5406 pragma Assert
(Is_Array_Type
(Id
));
5408 end Set_Packed_Array_Type
;
5410 procedure Set_Parent_Subtype
(Id
: E
; V
: E
) is
5412 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
5414 end Set_Parent_Subtype
;
5416 procedure Set_Part_Of_Constituents
(Id
: E
; V
: L
) is
5418 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
5420 end Set_Part_Of_Constituents
;
5422 procedure Set_Postcondition_Proc
(Id
: E
; V
: E
) is
5424 pragma Assert
(Ekind
(Id
) = E_Procedure
);
5426 end Set_Postcondition_Proc
;
5428 procedure Set_PPC_Wrapper
(Id
: E
; V
: E
) is
5430 pragma Assert
(Ekind_In
(Id
, E_Entry
, E_Entry_Family
));
5432 end Set_PPC_Wrapper
;
5434 procedure Set_Direct_Primitive_Operations
(Id
: E
; V
: L
) is
5436 pragma Assert
(Is_Tagged_Type
(Id
));
5437 Set_Elist10
(Id
, V
);
5438 end Set_Direct_Primitive_Operations
;
5440 procedure Set_Prival
(Id
: E
; V
: E
) is
5442 pragma Assert
(Is_Protected_Component
(Id
));
5446 procedure Set_Prival_Link
(Id
: E
; V
: E
) is
5448 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
5450 end Set_Prival_Link
;
5452 procedure Set_Private_Dependents
(Id
: E
; V
: L
) is
5454 pragma Assert
(Is_Incomplete_Or_Private_Type
(Id
));
5455 Set_Elist18
(Id
, V
);
5456 end Set_Private_Dependents
;
5458 procedure Set_Private_View
(Id
: E
; V
: N
) is
5460 pragma Assert
(Is_Private_Type
(Id
));
5462 end Set_Private_View
;
5464 procedure Set_Protected_Body_Subprogram
(Id
: E
; V
: E
) is
5466 pragma Assert
(Is_Subprogram
(Id
) or else Is_Entry
(Id
));
5468 end Set_Protected_Body_Subprogram
;
5470 procedure Set_Protected_Formal
(Id
: E
; V
: E
) is
5472 pragma Assert
(Is_Formal
(Id
));
5474 end Set_Protected_Formal
;
5476 procedure Set_Protection_Object
(Id
: E
; V
: E
) is
5478 pragma Assert
(Ekind_In
(Id
, E_Entry
,
5483 end Set_Protection_Object
;
5485 procedure Set_Reachable
(Id
: E
; V
: B
:= True) is
5490 procedure Set_Referenced
(Id
: E
; V
: B
:= True) is
5492 Set_Flag156
(Id
, V
);
5495 procedure Set_Referenced_As_LHS
(Id
: E
; V
: B
:= True) is
5498 end Set_Referenced_As_LHS
;
5500 procedure Set_Referenced_As_Out_Parameter
(Id
: E
; V
: B
:= True) is
5502 Set_Flag227
(Id
, V
);
5503 end Set_Referenced_As_Out_Parameter
;
5505 procedure Set_Refinement_Constituents
(Id
: E
; V
: L
) is
5507 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
5509 end Set_Refinement_Constituents
;
5511 procedure Set_Register_Exception_Call
(Id
: E
; V
: N
) is
5513 pragma Assert
(Ekind
(Id
) = E_Exception
);
5515 end Set_Register_Exception_Call
;
5517 procedure Set_Related_Array_Object
(Id
: E
; V
: E
) is
5519 pragma Assert
(Is_Array_Type
(Id
));
5521 end Set_Related_Array_Object
;
5523 procedure Set_Related_Expression
(Id
: E
; V
: N
) is
5525 pragma Assert
(Ekind
(Id
) in Type_Kind
5526 or else Ekind_In
(Id
, E_Constant
, E_Variable
, E_Void
));
5528 end Set_Related_Expression
;
5530 procedure Set_Related_Instance
(Id
: E
; V
: E
) is
5532 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Package_Body
));
5534 end Set_Related_Instance
;
5536 procedure Set_Related_Type
(Id
: E
; V
: E
) is
5538 pragma Assert
(Ekind_In
(Id
, E_Component
, E_Constant
, E_Variable
));
5540 end Set_Related_Type
;
5542 procedure Set_Relative_Deadline_Variable
(Id
: E
; V
: E
) is
5544 pragma Assert
(Is_Task_Type
(Id
) and then Is_Base_Type
(Id
));
5546 end Set_Relative_Deadline_Variable
;
5548 procedure Set_Renamed_Entity
(Id
: E
; V
: N
) is
5551 end Set_Renamed_Entity
;
5553 procedure Set_Renamed_In_Spec
(Id
: E
; V
: B
:= True) is
5555 pragma Assert
(Ekind
(Id
) = E_Package
);
5556 Set_Flag231
(Id
, V
);
5557 end Set_Renamed_In_Spec
;
5559 procedure Set_Renamed_Object
(Id
: E
; V
: N
) is
5562 end Set_Renamed_Object
;
5564 procedure Set_Renaming_Map
(Id
: E
; V
: U
) is
5567 end Set_Renaming_Map
;
5569 procedure Set_Requires_Overriding
(Id
: E
; V
: B
:= True) is
5571 pragma Assert
(Is_Overloadable
(Id
));
5572 Set_Flag213
(Id
, V
);
5573 end Set_Requires_Overriding
;
5575 procedure Set_Return_Present
(Id
: E
; V
: B
:= True) is
5578 end Set_Return_Present
;
5580 procedure Set_Return_Applies_To
(Id
: E
; V
: N
) is
5583 end Set_Return_Applies_To
;
5585 procedure Set_Returns_By_Ref
(Id
: E
; V
: B
:= True) is
5588 end Set_Returns_By_Ref
;
5590 procedure Set_Reverse_Bit_Order
(Id
: E
; V
: B
:= True) is
5593 (Is_Record_Type
(Id
) and then Is_Base_Type
(Id
));
5594 Set_Flag164
(Id
, V
);
5595 end Set_Reverse_Bit_Order
;
5597 procedure Set_Reverse_Storage_Order
(Id
: E
; V
: B
:= True) is
5601 and then (Is_Record_Type
(Id
) or else Is_Array_Type
(Id
)));
5603 end Set_Reverse_Storage_Order
;
5605 procedure Set_RM_Size
(Id
: E
; V
: U
) is
5607 pragma Assert
(Is_Type
(Id
));
5611 procedure Set_Scalar_Range
(Id
: E
; V
: N
) is
5614 end Set_Scalar_Range
;
5616 procedure Set_Scale_Value
(Id
: E
; V
: U
) is
5619 end Set_Scale_Value
;
5621 procedure Set_Scope_Depth_Value
(Id
: E
; V
: U
) is
5623 pragma Assert
(not Is_Record_Type
(Id
));
5625 end Set_Scope_Depth_Value
;
5627 procedure Set_Sec_Stack_Needed_For_Return
(Id
: E
; V
: B
:= True) is
5629 Set_Flag167
(Id
, V
);
5630 end Set_Sec_Stack_Needed_For_Return
;
5632 procedure Set_Shadow_Entities
(Id
: E
; V
: S
) is
5634 pragma Assert
(Ekind_In
(Id
, E_Package
, E_Generic_Package
));
5636 end Set_Shadow_Entities
;
5638 procedure Set_Shared_Var_Procs_Instance
(Id
: E
; V
: E
) is
5640 pragma Assert
(Ekind
(Id
) = E_Variable
);
5642 end Set_Shared_Var_Procs_Instance
;
5644 procedure Set_Size_Check_Code
(Id
: E
; V
: N
) is
5646 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
5648 end Set_Size_Check_Code
;
5650 procedure Set_Size_Depends_On_Discriminant
(Id
: E
; V
: B
:= True) is
5652 Set_Flag177
(Id
, V
);
5653 end Set_Size_Depends_On_Discriminant
;
5655 procedure Set_Size_Known_At_Compile_Time
(Id
: E
; V
: B
:= True) is
5658 end Set_Size_Known_At_Compile_Time
;
5660 procedure Set_Small_Value
(Id
: E
; V
: R
) is
5662 pragma Assert
(Is_Fixed_Point_Type
(Id
));
5663 Set_Ureal21
(Id
, V
);
5664 end Set_Small_Value
;
5666 procedure Set_SPARK_Aux_Pragma
(Id
: E
; V
: N
) is
5669 (Ekind_In
(Id
, E_Generic_Package
, -- package variants
5674 end Set_SPARK_Aux_Pragma
;
5676 procedure Set_SPARK_Aux_Pragma_Inherited
(Id
: E
; V
: B
:= True) is
5679 (Ekind_In
(Id
, E_Generic_Package
, -- package variants
5683 Set_Flag266
(Id
, V
);
5684 end Set_SPARK_Aux_Pragma_Inherited
;
5686 procedure Set_SPARK_Pragma
(Id
: E
; V
: N
) is
5689 (Ekind_In
(Id
, E_Function
, -- subprogram variants
5691 E_Generic_Procedure
,
5695 Ekind_In
(Id
, E_Generic_Package
, -- package variants
5700 end Set_SPARK_Pragma
;
5702 procedure Set_SPARK_Pragma_Inherited
(Id
: E
; V
: B
:= True) is
5705 (Ekind_In
(Id
, E_Function
, -- subprogram variants
5707 E_Generic_Procedure
,
5711 Ekind_In
(Id
, E_Generic_Package
, -- package variants
5715 Set_Flag265
(Id
, V
);
5716 end Set_SPARK_Pragma_Inherited
;
5718 procedure Set_Spec_Entity
(Id
: E
; V
: E
) is
5720 pragma Assert
(Ekind
(Id
) = E_Package_Body
or else Is_Formal
(Id
));
5722 end Set_Spec_Entity
;
5724 procedure Set_Static_Predicate
(Id
: E
; V
: S
) is
5727 (Ekind_In
(Id
, E_Enumeration_Subtype
,
5728 E_Modular_Integer_Subtype
,
5729 E_Signed_Integer_Subtype
)
5730 and then Has_Predicates
(Id
));
5732 end Set_Static_Predicate
;
5734 procedure Set_Status_Flag_Or_Transient_Decl
(Id
: E
; V
: E
) is
5736 pragma Assert
(Ekind_In
(Id
, E_Constant
, E_Variable
));
5738 end Set_Status_Flag_Or_Transient_Decl
;
5740 procedure Set_Storage_Size_Variable
(Id
: E
; V
: E
) is
5742 pragma Assert
(Is_Access_Type
(Id
) or else Is_Task_Type
(Id
));
5743 pragma Assert
(Id
= Base_Type
(Id
));
5745 end Set_Storage_Size_Variable
;
5747 procedure Set_Static_Elaboration_Desired
(Id
: E
; V
: B
) is
5749 pragma Assert
(Ekind
(Id
) = E_Package
);
5751 end Set_Static_Elaboration_Desired
;
5753 procedure Set_Static_Initialization
(Id
: E
; V
: N
) is
5756 (Ekind
(Id
) = E_Procedure
and then not Is_Dispatching_Operation
(Id
));
5758 end Set_Static_Initialization
;
5760 procedure Set_Stored_Constraint
(Id
: E
; V
: L
) is
5762 pragma Assert
(Nkind
(Id
) in N_Entity
);
5763 Set_Elist23
(Id
, V
);
5764 end Set_Stored_Constraint
;
5766 procedure Set_Strict_Alignment
(Id
: E
; V
: B
:= True) is
5768 pragma Assert
(Id
= Base_Type
(Id
));
5769 Set_Flag145
(Id
, V
);
5770 end Set_Strict_Alignment
;
5772 procedure Set_String_Literal_Length
(Id
: E
; V
: U
) is
5774 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
5776 end Set_String_Literal_Length
;
5778 procedure Set_String_Literal_Low_Bound
(Id
: E
; V
: N
) is
5780 pragma Assert
(Ekind
(Id
) = E_String_Literal_Subtype
);
5782 end Set_String_Literal_Low_Bound
;
5784 procedure Set_Subprograms_For_Type
(Id
: E
; V
: E
) is
5786 pragma Assert
(Is_Type
(Id
) or else Is_Subprogram
(Id
));
5788 end Set_Subprograms_For_Type
;
5790 procedure Set_Suppress_Elaboration_Warnings
(Id
: E
; V
: B
:= True) is
5792 Set_Flag148
(Id
, V
);
5793 end Set_Suppress_Elaboration_Warnings
;
5795 procedure Set_Suppress_Initialization
(Id
: E
; V
: B
:= True) is
5797 pragma Assert
(Is_Type
(Id
));
5798 Set_Flag105
(Id
, V
);
5799 end Set_Suppress_Initialization
;
5801 procedure Set_Suppress_Style_Checks
(Id
: E
; V
: B
:= True) is
5803 Set_Flag165
(Id
, V
);
5804 end Set_Suppress_Style_Checks
;
5806 procedure Set_Suppress_Value_Tracking_On_Call
(Id
: E
; V
: B
:= True) is
5808 Set_Flag217
(Id
, V
);
5809 end Set_Suppress_Value_Tracking_On_Call
;
5811 procedure Set_Task_Body_Procedure
(Id
: E
; V
: N
) is
5813 pragma Assert
(Ekind
(Id
) in Task_Kind
);
5815 end Set_Task_Body_Procedure
;
5817 procedure Set_Thunk_Entity
(Id
: E
; V
: E
) is
5819 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
)
5820 and then Is_Thunk
(Id
));
5822 end Set_Thunk_Entity
;
5824 procedure Set_Treat_As_Volatile
(Id
: E
; V
: B
:= True) is
5827 end Set_Treat_As_Volatile
;
5829 procedure Set_Underlying_Full_View
(Id
: E
; V
: E
) is
5831 pragma Assert
(Ekind
(Id
) in Private_Kind
);
5833 end Set_Underlying_Full_View
;
5835 procedure Set_Underlying_Record_View
(Id
: E
; V
: E
) is
5837 pragma Assert
(Ekind
(Id
) = E_Record_Type
);
5839 end Set_Underlying_Record_View
;
5841 procedure Set_Universal_Aliasing
(Id
: E
; V
: B
:= True) is
5843 pragma Assert
(Is_Type
(Id
) and then Is_Base_Type
(Id
));
5844 Set_Flag216
(Id
, V
);
5845 end Set_Universal_Aliasing
;
5847 procedure Set_Unset_Reference
(Id
: E
; V
: N
) is
5850 end Set_Unset_Reference
;
5852 procedure Set_Used_As_Generic_Actual
(Id
: E
; V
: B
:= True) is
5854 Set_Flag222
(Id
, V
);
5855 end Set_Used_As_Generic_Actual
;
5857 procedure Set_Uses_Lock_Free
(Id
: E
; V
: B
:= True) is
5859 pragma Assert
(Ekind
(Id
) = E_Protected_Type
);
5860 Set_Flag188
(Id
, V
);
5861 end Set_Uses_Lock_Free
;
5863 procedure Set_Uses_Sec_Stack
(Id
: E
; V
: B
:= True) is
5866 end Set_Uses_Sec_Stack
;
5868 procedure Set_Warnings_Off
(Id
: E
; V
: B
:= True) is
5871 end Set_Warnings_Off
;
5873 procedure Set_Warnings_Off_Used
(Id
: E
; V
: B
:= True) is
5875 Set_Flag236
(Id
, V
);
5876 end Set_Warnings_Off_Used
;
5878 procedure Set_Warnings_Off_Used_Unmodified
(Id
: E
; V
: B
:= True) is
5880 Set_Flag237
(Id
, V
);
5881 end Set_Warnings_Off_Used_Unmodified
;
5883 procedure Set_Warnings_Off_Used_Unreferenced
(Id
: E
; V
: B
:= True) is
5885 Set_Flag238
(Id
, V
);
5886 end Set_Warnings_Off_Used_Unreferenced
;
5888 procedure Set_Was_Hidden
(Id
: E
; V
: B
:= True) is
5890 Set_Flag196
(Id
, V
);
5893 procedure Set_Wrapped_Entity
(Id
: E
; V
: E
) is
5895 pragma Assert
(Ekind_In
(Id
, E_Function
, E_Procedure
)
5896 and then Is_Primitive_Wrapper
(Id
));
5898 end Set_Wrapped_Entity
;
5900 -----------------------------------
5901 -- Field Initialization Routines --
5902 -----------------------------------
5904 procedure Init_Alignment
(Id
: E
) is
5906 Set_Uint14
(Id
, Uint_0
);
5909 procedure Init_Alignment
(Id
: E
; V
: Int
) is
5911 Set_Uint14
(Id
, UI_From_Int
(V
));
5914 procedure Init_Component_Bit_Offset
(Id
: E
) is
5916 Set_Uint11
(Id
, No_Uint
);
5917 end Init_Component_Bit_Offset
;
5919 procedure Init_Component_Bit_Offset
(Id
: E
; V
: Int
) is
5921 Set_Uint11
(Id
, UI_From_Int
(V
));
5922 end Init_Component_Bit_Offset
;
5924 procedure Init_Component_Size
(Id
: E
) is
5926 Set_Uint22
(Id
, Uint_0
);
5927 end Init_Component_Size
;
5929 procedure Init_Component_Size
(Id
: E
; V
: Int
) is
5931 Set_Uint22
(Id
, UI_From_Int
(V
));
5932 end Init_Component_Size
;
5934 procedure Init_Digits_Value
(Id
: E
) is
5936 Set_Uint17
(Id
, Uint_0
);
5937 end Init_Digits_Value
;
5939 procedure Init_Digits_Value
(Id
: E
; V
: Int
) is
5941 Set_Uint17
(Id
, UI_From_Int
(V
));
5942 end Init_Digits_Value
;
5944 procedure Init_Esize
(Id
: E
) is
5946 Set_Uint12
(Id
, Uint_0
);
5949 procedure Init_Esize
(Id
: E
; V
: Int
) is
5951 Set_Uint12
(Id
, UI_From_Int
(V
));
5954 procedure Init_Normalized_First_Bit
(Id
: E
) is
5956 Set_Uint8
(Id
, No_Uint
);
5957 end Init_Normalized_First_Bit
;
5959 procedure Init_Normalized_First_Bit
(Id
: E
; V
: Int
) is
5961 Set_Uint8
(Id
, UI_From_Int
(V
));
5962 end Init_Normalized_First_Bit
;
5964 procedure Init_Normalized_Position
(Id
: E
) is
5966 Set_Uint14
(Id
, No_Uint
);
5967 end Init_Normalized_Position
;
5969 procedure Init_Normalized_Position
(Id
: E
; V
: Int
) is
5971 Set_Uint14
(Id
, UI_From_Int
(V
));
5972 end Init_Normalized_Position
;
5974 procedure Init_Normalized_Position_Max
(Id
: E
) is
5976 Set_Uint10
(Id
, No_Uint
);
5977 end Init_Normalized_Position_Max
;
5979 procedure Init_Normalized_Position_Max
(Id
: E
; V
: Int
) is
5981 Set_Uint10
(Id
, UI_From_Int
(V
));
5982 end Init_Normalized_Position_Max
;
5984 procedure Init_RM_Size
(Id
: E
) is
5986 Set_Uint13
(Id
, Uint_0
);
5989 procedure Init_RM_Size
(Id
: E
; V
: Int
) is
5991 Set_Uint13
(Id
, UI_From_Int
(V
));
5994 -----------------------------
5995 -- Init_Component_Location --
5996 -----------------------------
5998 procedure Init_Component_Location
(Id
: E
) is
6000 Set_Uint8
(Id
, No_Uint
); -- Normalized_First_Bit
6001 Set_Uint10
(Id
, No_Uint
); -- Normalized_Position_Max
6002 Set_Uint11
(Id
, No_Uint
); -- Component_Bit_Offset
6003 Set_Uint12
(Id
, Uint_0
); -- Esize
6004 Set_Uint14
(Id
, No_Uint
); -- Normalized_Position
6005 end Init_Component_Location
;
6007 ----------------------------
6008 -- Init_Object_Size_Align --
6009 ----------------------------
6011 procedure Init_Object_Size_Align
(Id
: E
) is
6013 Set_Uint12
(Id
, Uint_0
); -- Esize
6014 Set_Uint14
(Id
, Uint_0
); -- Alignment
6015 end Init_Object_Size_Align
;
6021 procedure Init_Size
(Id
: E
; V
: Int
) is
6023 pragma Assert
(not Is_Object
(Id
));
6024 Set_Uint12
(Id
, UI_From_Int
(V
)); -- Esize
6025 Set_Uint13
(Id
, UI_From_Int
(V
)); -- RM_Size
6028 ---------------------
6029 -- Init_Size_Align --
6030 ---------------------
6032 procedure Init_Size_Align
(Id
: E
) is
6034 pragma Assert
(not Is_Object
(Id
));
6035 Set_Uint12
(Id
, Uint_0
); -- Esize
6036 Set_Uint13
(Id
, Uint_0
); -- RM_Size
6037 Set_Uint14
(Id
, Uint_0
); -- Alignment
6038 end Init_Size_Align
;
6040 ----------------------------------------------
6041 -- Type Representation Attribute Predicates --
6042 ----------------------------------------------
6044 function Known_Alignment
(E
: Entity_Id
) return B
is
6046 return Uint14
(E
) /= Uint_0
6047 and then Uint14
(E
) /= No_Uint
;
6048 end Known_Alignment
;
6050 function Known_Component_Bit_Offset
(E
: Entity_Id
) return B
is
6052 return Uint11
(E
) /= No_Uint
;
6053 end Known_Component_Bit_Offset
;
6055 function Known_Component_Size
(E
: Entity_Id
) return B
is
6057 return Uint22
(Base_Type
(E
)) /= Uint_0
6058 and then Uint22
(Base_Type
(E
)) /= No_Uint
;
6059 end Known_Component_Size
;
6061 function Known_Esize
(E
: Entity_Id
) return B
is
6063 return Uint12
(E
) /= Uint_0
6064 and then Uint12
(E
) /= No_Uint
;
6067 function Known_Normalized_First_Bit
(E
: Entity_Id
) return B
is
6069 return Uint8
(E
) /= No_Uint
;
6070 end Known_Normalized_First_Bit
;
6072 function Known_Normalized_Position
(E
: Entity_Id
) return B
is
6074 return Uint14
(E
) /= No_Uint
;
6075 end Known_Normalized_Position
;
6077 function Known_Normalized_Position_Max
(E
: Entity_Id
) return B
is
6079 return Uint10
(E
) /= No_Uint
;
6080 end Known_Normalized_Position_Max
;
6082 function Known_RM_Size
(E
: Entity_Id
) return B
is
6084 return Uint13
(E
) /= No_Uint
6085 and then (Uint13
(E
) /= Uint_0
6086 or else Is_Discrete_Type
(E
)
6087 or else Is_Fixed_Point_Type
(E
));
6090 function Known_Static_Component_Bit_Offset
(E
: Entity_Id
) return B
is
6092 return Uint11
(E
) /= No_Uint
6093 and then Uint11
(E
) >= Uint_0
;
6094 end Known_Static_Component_Bit_Offset
;
6096 function Known_Static_Component_Size
(E
: Entity_Id
) return B
is
6098 return Uint22
(Base_Type
(E
)) > Uint_0
;
6099 end Known_Static_Component_Size
;
6101 function Known_Static_Esize
(E
: Entity_Id
) return B
is
6103 return Uint12
(E
) > Uint_0
6104 and then not Is_Generic_Type
(E
);
6105 end Known_Static_Esize
;
6107 function Known_Static_Normalized_First_Bit
(E
: Entity_Id
) return B
is
6109 return Uint8
(E
) /= No_Uint
6110 and then Uint8
(E
) >= Uint_0
;
6111 end Known_Static_Normalized_First_Bit
;
6113 function Known_Static_Normalized_Position
(E
: Entity_Id
) return B
is
6115 return Uint14
(E
) /= No_Uint
6116 and then Uint14
(E
) >= Uint_0
;
6117 end Known_Static_Normalized_Position
;
6119 function Known_Static_Normalized_Position_Max
(E
: Entity_Id
) return B
is
6121 return Uint10
(E
) /= No_Uint
6122 and then Uint10
(E
) >= Uint_0
;
6123 end Known_Static_Normalized_Position_Max
;
6125 function Known_Static_RM_Size
(E
: Entity_Id
) return B
is
6127 return (Uint13
(E
) > Uint_0
6128 or else Is_Discrete_Type
(E
)
6129 or else Is_Fixed_Point_Type
(E
))
6130 and then not Is_Generic_Type
(E
);
6131 end Known_Static_RM_Size
;
6133 function Unknown_Alignment
(E
: Entity_Id
) return B
is
6135 return Uint14
(E
) = Uint_0
6136 or else Uint14
(E
) = No_Uint
;
6137 end Unknown_Alignment
;
6139 function Unknown_Component_Bit_Offset
(E
: Entity_Id
) return B
is
6141 return Uint11
(E
) = No_Uint
;
6142 end Unknown_Component_Bit_Offset
;
6144 function Unknown_Component_Size
(E
: Entity_Id
) return B
is
6146 return Uint22
(Base_Type
(E
)) = Uint_0
6148 Uint22
(Base_Type
(E
)) = No_Uint
;
6149 end Unknown_Component_Size
;
6151 function Unknown_Esize
(E
: Entity_Id
) return B
is
6153 return Uint12
(E
) = No_Uint
6155 Uint12
(E
) = Uint_0
;
6158 function Unknown_Normalized_First_Bit
(E
: Entity_Id
) return B
is
6160 return Uint8
(E
) = No_Uint
;
6161 end Unknown_Normalized_First_Bit
;
6163 function Unknown_Normalized_Position
(E
: Entity_Id
) return B
is
6165 return Uint14
(E
) = No_Uint
;
6166 end Unknown_Normalized_Position
;
6168 function Unknown_Normalized_Position_Max
(E
: Entity_Id
) return B
is
6170 return Uint10
(E
) = No_Uint
;
6171 end Unknown_Normalized_Position_Max
;
6173 function Unknown_RM_Size
(E
: Entity_Id
) return B
is
6175 return (Uint13
(E
) = Uint_0
6176 and then not Is_Discrete_Type
(E
)
6177 and then not Is_Fixed_Point_Type
(E
))
6178 or else Uint13
(E
) = No_Uint
;
6179 end Unknown_RM_Size
;
6181 --------------------
6182 -- Address_Clause --
6183 --------------------
6185 function Address_Clause
(Id
: E
) return N
is
6187 return Get_Attribute_Definition_Clause
(Id
, Attribute_Address
);
6194 function Aft_Value
(Id
: E
) return U
is
6196 Delta_Val
: Ureal
:= Delta_Value
(Id
);
6198 while Delta_Val
< Ureal_Tenth
loop
6199 Delta_Val
:= Delta_Val
* Ureal_10
;
6200 Result
:= Result
+ 1;
6203 return UI_From_Int
(Result
);
6206 ----------------------
6207 -- Alignment_Clause --
6208 ----------------------
6210 function Alignment_Clause
(Id
: E
) return N
is
6212 return Get_Attribute_Definition_Clause
(Id
, Attribute_Alignment
);
6213 end Alignment_Clause
;
6219 procedure Append_Entity
(Id
: Entity_Id
; V
: Entity_Id
) is
6221 if Last_Entity
(V
) = Empty
then
6222 Set_First_Entity
(Id
=> V
, V
=> Id
);
6224 Set_Next_Entity
(Last_Entity
(V
), Id
);
6227 Set_Next_Entity
(Id
, Empty
);
6229 Set_Last_Entity
(Id
=> V
, V
=> Id
);
6236 function Base_Type
(Id
: E
) return E
is
6238 if Is_Base_Type
(Id
) then
6241 pragma Assert
(Is_Type
(Id
));
6246 -------------------------
6247 -- Component_Alignment --
6248 -------------------------
6250 -- Component Alignment is encoded using two flags, Flag128/129 as
6251 -- follows. Note that both flags False = Align_Default, so that the
6252 -- default initialization of flags to False initializes component
6253 -- alignment to the default value as required.
6255 -- Flag128 Flag129 Value
6256 -- ------- ------- -----
6257 -- False False Calign_Default
6258 -- False True Calign_Component_Size
6259 -- True False Calign_Component_Size_4
6260 -- True True Calign_Storage_Unit
6262 function Component_Alignment
(Id
: E
) return C
is
6263 BT
: constant Node_Id
:= Base_Type
(Id
);
6266 pragma Assert
(Is_Array_Type
(Id
) or else Is_Record_Type
(Id
));
6268 if Flag128
(BT
) then
6269 if Flag129
(BT
) then
6270 return Calign_Storage_Unit
;
6272 return Calign_Component_Size_4
;
6276 if Flag129
(BT
) then
6277 return Calign_Component_Size
;
6279 return Calign_Default
;
6282 end Component_Alignment
;
6284 ----------------------
6285 -- Declaration_Node --
6286 ----------------------
6288 function Declaration_Node
(Id
: E
) return N
is
6292 if Ekind
(Id
) = E_Incomplete_Type
6293 and then Present
(Full_View
(Id
))
6295 P
:= Parent
(Full_View
(Id
));
6301 if Nkind
(P
) /= N_Selected_Component
6302 and then Nkind
(P
) /= N_Expanded_Name
6304 not (Nkind
(P
) = N_Defining_Program_Unit_Name
6305 and then Is_Child_Unit
(Id
))
6312 end Declaration_Node
;
6314 ---------------------
6315 -- Designated_Type --
6316 ---------------------
6318 function Designated_Type
(Id
: E
) return E
is
6322 Desig_Type
:= Directly_Designated_Type
(Id
);
6324 if Ekind
(Desig_Type
) = E_Incomplete_Type
6325 and then Present
(Full_View
(Desig_Type
))
6327 return Full_View
(Desig_Type
);
6329 elsif Is_Class_Wide_Type
(Desig_Type
)
6330 and then Ekind
(Etype
(Desig_Type
)) = E_Incomplete_Type
6331 and then Present
(Full_View
(Etype
(Desig_Type
)))
6332 and then Present
(Class_Wide_Type
(Full_View
(Etype
(Desig_Type
))))
6334 return Class_Wide_Type
(Full_View
(Etype
(Desig_Type
)));
6339 end Designated_Type
;
6341 ----------------------
6342 -- Entry_Index_Type --
6343 ----------------------
6345 function Entry_Index_Type
(Id
: E
) return N
is
6347 pragma Assert
(Ekind
(Id
) = E_Entry_Family
);
6348 return Etype
(Discrete_Subtype_Definition
(Parent
(Id
)));
6349 end Entry_Index_Type
;
6351 ---------------------
6352 -- First_Component --
6353 ---------------------
6355 function First_Component
(Id
: E
) return E
is
6360 (Is_Record_Type
(Id
) or else Is_Incomplete_Or_Private_Type
(Id
));
6362 Comp_Id
:= First_Entity
(Id
);
6363 while Present
(Comp_Id
) loop
6364 exit when Ekind
(Comp_Id
) = E_Component
;
6365 Comp_Id
:= Next_Entity
(Comp_Id
);
6369 end First_Component
;
6371 -------------------------------------
6372 -- First_Component_Or_Discriminant --
6373 -------------------------------------
6375 function First_Component_Or_Discriminant
(Id
: E
) return E
is
6380 (Is_Record_Type
(Id
)
6381 or else Is_Incomplete_Or_Private_Type
(Id
)
6382 or else Has_Discriminants
(Id
));
6384 Comp_Id
:= First_Entity
(Id
);
6385 while Present
(Comp_Id
) loop
6386 exit when Ekind_In
(Comp_Id
, E_Component
, E_Discriminant
);
6387 Comp_Id
:= Next_Entity
(Comp_Id
);
6391 end First_Component_Or_Discriminant
;
6397 function First_Formal
(Id
: E
) return E
is
6402 (Is_Overloadable
(Id
)
6403 or else Ekind_In
(Id
, E_Entry_Family
,
6405 E_Subprogram_Type
));
6407 if Ekind
(Id
) = E_Enumeration_Literal
then
6411 Formal
:= First_Entity
(Id
);
6413 if Present
(Formal
) and then Is_Formal
(Formal
) then
6421 ------------------------------
6422 -- First_Formal_With_Extras --
6423 ------------------------------
6425 function First_Formal_With_Extras
(Id
: E
) return E
is
6430 (Is_Overloadable
(Id
)
6431 or else Ekind_In
(Id
, E_Entry_Family
,
6433 E_Subprogram_Type
));
6435 if Ekind
(Id
) = E_Enumeration_Literal
then
6439 Formal
:= First_Entity
(Id
);
6441 if Present
(Formal
) and then Is_Formal
(Formal
) then
6444 return Extra_Formals
(Id
); -- Empty if no extra formals
6447 end First_Formal_With_Extras
;
6449 -------------------------------------
6450 -- Get_Attribute_Definition_Clause --
6451 -------------------------------------
6453 function Get_Attribute_Definition_Clause
6455 Id
: Attribute_Id
) return Node_Id
6460 N
:= First_Rep_Item
(E
);
6461 while Present
(N
) loop
6462 if Nkind
(N
) = N_Attribute_Definition_Clause
6463 and then Get_Attribute_Id
(Chars
(N
)) = Id
6472 end Get_Attribute_Definition_Clause
;
6478 function Get_Full_View
(T
: Entity_Id
) return Entity_Id
is
6480 if Ekind
(T
) = E_Incomplete_Type
and then Present
(Full_View
(T
)) then
6481 return Full_View
(T
);
6483 elsif Is_Class_Wide_Type
(T
)
6484 and then Ekind
(Root_Type
(T
)) = E_Incomplete_Type
6485 and then Present
(Full_View
(Root_Type
(T
)))
6487 return Class_Wide_Type
(Full_View
(Root_Type
(T
)));
6498 function Get_Pragma
(E
: Entity_Id
; Id
: Pragma_Id
) return Node_Id
is
6499 Is_CDG
: constant Boolean :=
6500 Id
= Pragma_Abstract_State
or else
6501 Id
= Pragma_Async_Readers
or else
6502 Id
= Pragma_Async_Writers
or else
6503 Id
= Pragma_Depends
or else
6504 Id
= Pragma_Effective_Reads
or else
6505 Id
= Pragma_Effective_Writes
or else
6506 Id
= Pragma_Global
or else
6507 Id
= Pragma_Initial_Condition
or else
6508 Id
= Pragma_Initializes
or else
6509 Id
= Pragma_Part_Of
or else
6510 Id
= Pragma_Refined_Depends
or else
6511 Id
= Pragma_Refined_Global
or else
6512 Id
= Pragma_Refined_State
;
6513 Is_CTC
: constant Boolean :=
6514 Id
= Pragma_Contract_Cases
or else
6515 Id
= Pragma_Test_Case
;
6516 Is_PPC
: constant Boolean :=
6517 Id
= Pragma_Precondition
or else
6518 Id
= Pragma_Postcondition
or else
6519 Id
= Pragma_Refined_Post
;
6521 In_Contract
: constant Boolean := Is_CDG
or Is_CTC
or Is_PPC
;
6527 -- Handle pragmas that appear in N_Contract nodes. Those have to be
6528 -- extracted from their specialized list.
6531 Items
:= Contract
(E
);
6537 Item
:= Classifications
(Items
);
6540 Item
:= Contract_Test_Cases
(Items
);
6543 Item
:= Pre_Post_Conditions
(Items
);
6549 Item
:= First_Rep_Item
(E
);
6552 while Present
(Item
) loop
6553 if Nkind
(Item
) = N_Pragma
6554 and then Get_Pragma_Id
(Pragma_Name
(Item
)) = Id
6558 -- All nodes in N_Contract are chained using Next_Pragma
6560 elsif In_Contract
then
6561 Item
:= Next_Pragma
(Item
);
6566 Next_Rep_Item
(Item
);
6573 --------------------------------------
6574 -- Get_Record_Representation_Clause --
6575 --------------------------------------
6577 function Get_Record_Representation_Clause
(E
: Entity_Id
) return Node_Id
is
6581 N
:= First_Rep_Item
(E
);
6582 while Present
(N
) loop
6583 if Nkind
(N
) = N_Record_Representation_Clause
then
6591 end Get_Record_Representation_Clause
;
6593 ------------------------
6594 -- Has_Attach_Handler --
6595 ------------------------
6597 function Has_Attach_Handler
(Id
: E
) return B
is
6601 pragma Assert
(Is_Protected_Type
(Id
));
6603 Ritem
:= First_Rep_Item
(Id
);
6604 while Present
(Ritem
) loop
6605 if Nkind
(Ritem
) = N_Pragma
6606 and then Pragma_Name
(Ritem
) = Name_Attach_Handler
6610 Next_Rep_Item
(Ritem
);
6615 end Has_Attach_Handler
;
6621 function Has_Entries
(Id
: E
) return B
is
6625 pragma Assert
(Is_Concurrent_Type
(Id
));
6627 Ent
:= First_Entity
(Id
);
6628 while Present
(Ent
) loop
6629 if Is_Entry
(Ent
) then
6633 Ent
:= Next_Entity
(Ent
);
6639 ----------------------------
6640 -- Has_Foreign_Convention --
6641 ----------------------------
6643 function Has_Foreign_Convention
(Id
: E
) return B
is
6645 -- While regular Intrinsics such as the Standard operators fit in the
6646 -- "Ada" convention, those with an Interface_Name materialize GCC
6647 -- builtin imports for which Ada special treatments shouldn't apply.
6649 return Convention
(Id
) in Foreign_Convention
6650 or else (Convention
(Id
) = Convention_Intrinsic
6651 and then Present
(Interface_Name
(Id
)));
6652 end Has_Foreign_Convention
;
6654 ---------------------------
6655 -- Has_Interrupt_Handler --
6656 ---------------------------
6658 function Has_Interrupt_Handler
(Id
: E
) return B
is
6662 pragma Assert
(Is_Protected_Type
(Id
));
6664 Ritem
:= First_Rep_Item
(Id
);
6665 while Present
(Ritem
) loop
6666 if Nkind
(Ritem
) = N_Pragma
6667 and then Pragma_Name
(Ritem
) = Name_Interrupt_Handler
6671 Next_Rep_Item
(Ritem
);
6676 end Has_Interrupt_Handler
;
6678 -----------------------------
6679 -- Has_Non_Null_Refinement --
6680 -----------------------------
6682 function Has_Non_Null_Refinement
(Id
: E
) return B
is
6684 -- "Refinement" is a concept applicable only to abstract states
6686 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
6688 if Has_Visible_Refinement
(Id
) then
6689 pragma Assert
(Present
(Refinement_Constituents
(Id
)));
6691 -- For a refinement to be non-null, the first constituent must be
6692 -- anything other than null.
6695 Nkind
(Node
(First_Elmt
(Refinement_Constituents
(Id
)))) /= N_Null
;
6699 end Has_Non_Null_Refinement
;
6701 -----------------------------
6702 -- Has_Null_Abstract_State --
6703 -----------------------------
6705 function Has_Null_Abstract_State
(Id
: E
) return B
is
6707 pragma Assert
(Ekind_In
(Id
, E_Generic_Package
, E_Package
));
6710 Present
(Abstract_States
(Id
))
6711 and then Is_Null_State
(Node
(First_Elmt
(Abstract_States
(Id
))));
6712 end Has_Null_Abstract_State
;
6714 -------------------------
6715 -- Has_Null_Refinement --
6716 -------------------------
6718 function Has_Null_Refinement
(Id
: E
) return B
is
6720 -- "Refinement" is a concept applicable only to abstract states
6722 pragma Assert
(Ekind
(Id
) = E_Abstract_State
);
6724 if Has_Visible_Refinement
(Id
) then
6725 pragma Assert
(Present
(Refinement_Constituents
(Id
)));
6727 -- For a refinement to be null, the state's sole constituent must be
6731 Nkind
(Node
(First_Elmt
(Refinement_Constituents
(Id
)))) = N_Null
;
6735 end Has_Null_Refinement
;
6737 --------------------
6738 -- Has_Unmodified --
6739 --------------------
6741 function Has_Unmodified
(E
: Entity_Id
) return Boolean is
6743 if Has_Pragma_Unmodified
(E
) then
6745 elsif Warnings_Off
(E
) then
6746 Set_Warnings_Off_Used_Unmodified
(E
);
6753 ---------------------
6754 -- Has_Unreferenced --
6755 ---------------------
6757 function Has_Unreferenced
(E
: Entity_Id
) return Boolean is
6759 if Has_Pragma_Unreferenced
(E
) then
6761 elsif Warnings_Off
(E
) then
6762 Set_Warnings_Off_Used_Unreferenced
(E
);
6767 end Has_Unreferenced
;
6769 ----------------------
6770 -- Has_Warnings_Off --
6771 ----------------------
6773 function Has_Warnings_Off
(E
: Entity_Id
) return Boolean is
6775 if Warnings_Off
(E
) then
6776 Set_Warnings_Off_Used
(E
);
6781 end Has_Warnings_Off
;
6783 ------------------------------
6784 -- Implementation_Base_Type --
6785 ------------------------------
6787 function Implementation_Base_Type
(Id
: E
) return E
is
6792 Bastyp
:= Base_Type
(Id
);
6794 if Is_Incomplete_Or_Private_Type
(Bastyp
) then
6795 Imptyp
:= Underlying_Type
(Bastyp
);
6797 -- If we have an implementation type, then just return it,
6798 -- otherwise we return the Base_Type anyway. This can only
6799 -- happen in error situations and should avoid some error bombs.
6801 if Present
(Imptyp
) then
6802 return Base_Type
(Imptyp
);
6810 end Implementation_Base_Type
;
6812 -------------------------
6813 -- Invariant_Procedure --
6814 -------------------------
6816 function Invariant_Procedure
(Id
: E
) return E
is
6820 pragma Assert
(Is_Type
(Id
) and then Has_Invariants
(Id
));
6822 if No
(Subprograms_For_Type
(Id
)) then
6826 S
:= Subprograms_For_Type
(Id
);
6827 while Present
(S
) loop
6828 if Is_Invariant_Procedure
(S
) then
6831 S
:= Subprograms_For_Type
(S
);
6837 end Invariant_Procedure
;
6843 -- Global flag table allowing rapid computation of this function
6845 Entity_Is_Base_Type
: constant array (Entity_Kind
) of Boolean :=
6846 (E_Enumeration_Subtype |
6848 E_Signed_Integer_Subtype |
6849 E_Modular_Integer_Subtype |
6850 E_Floating_Point_Subtype |
6851 E_Ordinary_Fixed_Point_Subtype |
6852 E_Decimal_Fixed_Point_Subtype |
6857 E_Record_Subtype_With_Private |
6858 E_Limited_Private_Subtype |
6860 E_Protected_Subtype |
6862 E_String_Literal_Subtype |
6863 E_Class_Wide_Subtype
=> False,
6866 function Is_Base_Type
(Id
: E
) return Boolean is
6868 return Entity_Is_Base_Type
(Ekind
(Id
));
6871 ---------------------
6872 -- Is_Boolean_Type --
6873 ---------------------
6875 function Is_Boolean_Type
(Id
: E
) return B
is
6877 return Root_Type
(Id
) = Standard_Boolean
;
6878 end Is_Boolean_Type
;
6880 ------------------------
6881 -- Is_Constant_Object --
6882 ------------------------
6884 function Is_Constant_Object
(Id
: E
) return B
is
6885 K
: constant Entity_Kind
:= Ekind
(Id
);
6888 K
= E_Constant
or else K
= E_In_Parameter
or else K
= E_Loop_Parameter
;
6889 end Is_Constant_Object
;
6891 --------------------
6892 -- Is_Discriminal --
6893 --------------------
6895 function Is_Discriminal
(Id
: E
) return B
is
6897 return (Ekind_In
(Id
, E_Constant
, E_In_Parameter
)
6898 and then Present
(Discriminal_Link
(Id
)));
6901 ----------------------
6902 -- Is_Dynamic_Scope --
6903 ----------------------
6905 function Is_Dynamic_Scope
(Id
: E
) return B
is
6908 Ekind
(Id
) = E_Block
6910 Ekind
(Id
) = E_Function
6912 Ekind
(Id
) = E_Procedure
6914 Ekind
(Id
) = E_Subprogram_Body
6916 Ekind
(Id
) = E_Task_Type
6918 (Ekind
(Id
) = E_Limited_Private_Type
6919 and then Present
(Full_View
(Id
))
6920 and then Ekind
(Full_View
(Id
)) = E_Task_Type
)
6922 Ekind
(Id
) = E_Entry
6924 Ekind
(Id
) = E_Entry_Family
6926 Ekind
(Id
) = E_Return_Statement
;
6927 end Is_Dynamic_Scope
;
6929 --------------------
6930 -- Is_Entity_Name --
6931 --------------------
6933 function Is_Entity_Name
(N
: Node_Id
) return Boolean is
6934 Kind
: constant Node_Kind
:= Nkind
(N
);
6937 -- Identifiers, operator symbols, expanded names are entity names
6939 return Kind
= N_Identifier
6940 or else Kind
= N_Operator_Symbol
6941 or else Kind
= N_Expanded_Name
6943 -- Attribute references are entity names if they refer to an entity.
6944 -- Note that we don't do this by testing for the presence of the
6945 -- Entity field in the N_Attribute_Reference node, since it may not
6946 -- have been set yet.
6948 or else (Kind
= N_Attribute_Reference
6949 and then Is_Entity_Attribute_Name
(Attribute_Name
(N
)));
6952 -----------------------
6953 -- Is_External_State --
6954 -----------------------
6956 function Is_External_State
(Id
: E
) return B
is
6959 Ekind
(Id
) = E_Abstract_State
and then Has_Option
(Id
, Name_External
);
6960 end Is_External_State
;
6966 function Is_Finalizer
(Id
: E
) return B
is
6968 return Ekind
(Id
) = E_Procedure
and then Chars
(Id
) = Name_uFinalizer
;
6971 ---------------------
6972 -- Is_Ghost_Entity --
6973 ---------------------
6975 -- Note: coding below allows for ghost variables. They are not currently
6976 -- implemented, so we will always get False for variables, but that is
6977 -- expected to change in the future.
6979 function Is_Ghost_Entity
(Id
: E
) return B
is
6981 if Present
(Id
) and then Ekind
(Id
) = E_Variable
then
6982 return Convention
(Id
) = Convention_Ghost
;
6984 return Is_Ghost_Subprogram
(Id
);
6986 end Is_Ghost_Entity
;
6988 -------------------------
6989 -- Is_Ghost_Subprogram --
6990 -------------------------
6992 function Is_Ghost_Subprogram
(Id
: E
) return B
is
6994 if Present
(Id
) and then Ekind_In
(Id
, E_Function
, E_Procedure
) then
6995 return Convention
(Id
) = Convention_Ghost
;
6999 end Is_Ghost_Subprogram
;
7005 function Is_Null_State
(Id
: E
) return B
is
7008 Ekind
(Id
) = E_Abstract_State
and then Nkind
(Parent
(Id
)) = N_Null
;
7011 -----------------------------------
7012 -- Is_Package_Or_Generic_Package --
7013 -----------------------------------
7015 function Is_Package_Or_Generic_Package
(Id
: E
) return B
is
7017 return Ekind_In
(Id
, E_Generic_Package
, E_Package
);
7018 end Is_Package_Or_Generic_Package
;
7024 function Is_Prival
(Id
: E
) return B
is
7026 return (Ekind_In
(Id
, E_Constant
, E_Variable
)
7027 and then Present
(Prival_Link
(Id
)));
7030 ----------------------------
7031 -- Is_Protected_Component --
7032 ----------------------------
7034 function Is_Protected_Component
(Id
: E
) return B
is
7036 return Ekind
(Id
) = E_Component
and then Is_Protected_Type
(Scope
(Id
));
7037 end Is_Protected_Component
;
7039 ----------------------------
7040 -- Is_Protected_Interface --
7041 ----------------------------
7043 function Is_Protected_Interface
(Id
: E
) return B
is
7044 Typ
: constant Entity_Id
:= Base_Type
(Id
);
7046 if not Is_Interface
(Typ
) then
7048 elsif Is_Class_Wide_Type
(Typ
) then
7049 return Is_Protected_Interface
(Etype
(Typ
));
7051 return Protected_Present
(Type_Definition
(Parent
(Typ
)));
7053 end Is_Protected_Interface
;
7055 ------------------------------
7056 -- Is_Protected_Record_Type --
7057 ------------------------------
7059 function Is_Protected_Record_Type
(Id
: E
) return B
is
7062 Is_Concurrent_Record_Type
(Id
)
7063 and then Is_Protected_Type
(Corresponding_Concurrent_Type
(Id
));
7064 end Is_Protected_Record_Type
;
7066 --------------------------------
7067 -- Is_Standard_Character_Type --
7068 --------------------------------
7070 function Is_Standard_Character_Type
(Id
: E
) return B
is
7072 if Is_Type
(Id
) then
7074 R
: constant Entity_Id
:= Root_Type
(Id
);
7077 R
= Standard_Character
7079 R
= Standard_Wide_Character
7081 R
= Standard_Wide_Wide_Character
;
7087 end Is_Standard_Character_Type
;
7089 --------------------
7090 -- Is_String_Type --
7091 --------------------
7093 function Is_String_Type
(Id
: E
) return B
is
7095 return Ekind
(Id
) in String_Kind
7096 or else (Is_Array_Type
(Id
)
7097 and then Id
/= Any_Composite
7098 and then Number_Dimensions
(Id
) = 1
7099 and then Is_Character_Type
(Component_Type
(Id
)));
7102 -------------------------------
7103 -- Is_Synchronized_Interface --
7104 -------------------------------
7106 function Is_Synchronized_Interface
(Id
: E
) return B
is
7107 Typ
: constant Entity_Id
:= Base_Type
(Id
);
7110 if not Is_Interface
(Typ
) then
7113 elsif Is_Class_Wide_Type
(Typ
) then
7114 return Is_Synchronized_Interface
(Etype
(Typ
));
7117 return Protected_Present
(Type_Definition
(Parent
(Typ
)))
7118 or else Synchronized_Present
(Type_Definition
(Parent
(Typ
)))
7119 or else Task_Present
(Type_Definition
(Parent
(Typ
)));
7121 end Is_Synchronized_Interface
;
7123 -----------------------
7124 -- Is_Task_Interface --
7125 -----------------------
7127 function Is_Task_Interface
(Id
: E
) return B
is
7128 Typ
: constant Entity_Id
:= Base_Type
(Id
);
7130 if not Is_Interface
(Typ
) then
7132 elsif Is_Class_Wide_Type
(Typ
) then
7133 return Is_Task_Interface
(Etype
(Typ
));
7135 return Task_Present
(Type_Definition
(Parent
(Typ
)));
7137 end Is_Task_Interface
;
7139 -------------------------
7140 -- Is_Task_Record_Type --
7141 -------------------------
7143 function Is_Task_Record_Type
(Id
: E
) return B
is
7146 Is_Concurrent_Record_Type
(Id
)
7147 and then Is_Task_Type
(Corresponding_Concurrent_Type
(Id
));
7148 end Is_Task_Record_Type
;
7150 ------------------------
7151 -- Is_Wrapper_Package --
7152 ------------------------
7154 function Is_Wrapper_Package
(Id
: E
) return B
is
7156 return (Ekind
(Id
) = E_Package
and then Present
(Related_Instance
(Id
)));
7157 end Is_Wrapper_Package
;
7163 function Last_Formal
(Id
: E
) return E
is
7168 (Is_Overloadable
(Id
)
7169 or else Ekind_In
(Id
, E_Entry_Family
,
7171 E_Subprogram_Type
));
7173 if Ekind
(Id
) = E_Enumeration_Literal
then
7177 Formal
:= First_Formal
(Id
);
7179 if Present
(Formal
) then
7180 while Present
(Next_Formal
(Formal
)) loop
7181 Formal
:= Next_Formal
(Formal
);
7189 function Model_Emin_Value
(Id
: E
) return Uint
is
7191 return Machine_Emin_Value
(Id
);
7192 end Model_Emin_Value
;
7194 -------------------------
7195 -- Model_Epsilon_Value --
7196 -------------------------
7198 function Model_Epsilon_Value
(Id
: E
) return Ureal
is
7199 Radix
: constant Ureal
:= UR_From_Uint
(Machine_Radix_Value
(Id
));
7201 return Radix
** (1 - Model_Mantissa_Value
(Id
));
7202 end Model_Epsilon_Value
;
7204 --------------------------
7205 -- Model_Mantissa_Value --
7206 --------------------------
7208 function Model_Mantissa_Value
(Id
: E
) return Uint
is
7210 return Machine_Mantissa_Value
(Id
);
7211 end Model_Mantissa_Value
;
7213 -----------------------
7214 -- Model_Small_Value --
7215 -----------------------
7217 function Model_Small_Value
(Id
: E
) return Ureal
is
7218 Radix
: constant Ureal
:= UR_From_Uint
(Machine_Radix_Value
(Id
));
7220 return Radix
** (Model_Emin_Value
(Id
) - 1);
7221 end Model_Small_Value
;
7223 ------------------------
7224 -- Machine_Emax_Value --
7225 ------------------------
7227 function Machine_Emax_Value
(Id
: E
) return Uint
is
7228 Digs
: constant Pos
:= UI_To_Int
(Digits_Value
(Base_Type
(Id
)));
7231 case Float_Rep
(Id
) is
7234 when 1 .. 6 => return Uint_128
;
7235 when 7 .. 15 => return 2**10;
7236 when 16 .. 33 => return 2**14;
7237 when others => return No_Uint
;
7242 when 1 .. 9 => return 2**7 - 1;
7243 when 10 .. 15 => return 2**10 - 1;
7244 when others => return No_Uint
;
7248 return Uint_2
** Uint_7
- Uint_1
;
7250 end Machine_Emax_Value
;
7252 ------------------------
7253 -- Machine_Emin_Value --
7254 ------------------------
7256 function Machine_Emin_Value
(Id
: E
) return Uint
is
7258 case Float_Rep
(Id
) is
7259 when IEEE_Binary
=> return Uint_3
- Machine_Emax_Value
(Id
);
7260 when VAX_Native
=> return -Machine_Emax_Value
(Id
);
7261 when AAMP
=> return -Machine_Emax_Value
(Id
);
7263 end Machine_Emin_Value
;
7265 ----------------------------
7266 -- Machine_Mantissa_Value --
7267 ----------------------------
7269 function Machine_Mantissa_Value
(Id
: E
) return Uint
is
7270 Digs
: constant Pos
:= UI_To_Int
(Digits_Value
(Base_Type
(Id
)));
7273 case Float_Rep
(Id
) is
7276 when 1 .. 6 => return Uint_24
;
7277 when 7 .. 15 => return UI_From_Int
(53);
7278 when 16 .. 18 => return Uint_64
;
7279 when 19 .. 33 => return UI_From_Int
(113);
7280 when others => return No_Uint
;
7285 when 1 .. 6 => return Uint_24
;
7286 when 7 .. 9 => return UI_From_Int
(56);
7287 when 10 .. 15 => return UI_From_Int
(53);
7288 when others => return No_Uint
;
7293 when 1 .. 6 => return Uint_24
;
7294 when 7 .. 9 => return UI_From_Int
(40);
7295 when others => return No_Uint
;
7298 end Machine_Mantissa_Value
;
7300 -------------------------
7301 -- Machine_Radix_Value --
7302 -------------------------
7304 function Machine_Radix_Value
(Id
: E
) return U
is
7306 case Float_Rep
(Id
) is
7307 when IEEE_Binary | VAX_Native | AAMP
=>
7310 end Machine_Radix_Value
;
7312 --------------------
7313 -- Next_Component --
7314 --------------------
7316 function Next_Component
(Id
: E
) return E
is
7320 Comp_Id
:= Next_Entity
(Id
);
7321 while Present
(Comp_Id
) loop
7322 exit when Ekind
(Comp_Id
) = E_Component
;
7323 Comp_Id
:= Next_Entity
(Comp_Id
);
7329 ------------------------------------
7330 -- Next_Component_Or_Discriminant --
7331 ------------------------------------
7333 function Next_Component_Or_Discriminant
(Id
: E
) return E
is
7337 Comp_Id
:= Next_Entity
(Id
);
7338 while Present
(Comp_Id
) loop
7339 exit when Ekind_In
(Comp_Id
, E_Component
, E_Discriminant
);
7340 Comp_Id
:= Next_Entity
(Comp_Id
);
7344 end Next_Component_Or_Discriminant
;
7346 -----------------------
7347 -- Next_Discriminant --
7348 -----------------------
7350 -- This function actually implements both Next_Discriminant and
7351 -- Next_Stored_Discriminant by making sure that the Discriminant
7352 -- returned is of the same variety as Id.
7354 function Next_Discriminant
(Id
: E
) return E
is
7356 -- Derived Tagged types with private extensions look like this...
7358 -- E_Discriminant d1
7359 -- E_Discriminant d2
7361 -- E_Discriminant d1
7362 -- E_Discriminant d2
7365 -- so it is critical not to go past the leading discriminants
7370 pragma Assert
(Ekind
(Id
) = E_Discriminant
);
7373 D
:= Next_Entity
(D
);
7375 or else (Ekind
(D
) /= E_Discriminant
7376 and then not Is_Itype
(D
))
7381 exit when Ekind
(D
) = E_Discriminant
7382 and then (Is_Completely_Hidden
(D
) = Is_Completely_Hidden
(Id
));
7386 end Next_Discriminant
;
7392 function Next_Formal
(Id
: E
) return E
is
7396 -- Follow the chain of declared entities as long as the kind of the
7397 -- entity corresponds to a formal parameter. Skip internal entities
7398 -- that may have been created for implicit subtypes, in the process
7399 -- of analyzing default expressions.
7403 P
:= Next_Entity
(P
);
7405 if No
(P
) or else Is_Formal
(P
) then
7407 elsif not Is_Internal
(P
) then
7413 -----------------------------
7414 -- Next_Formal_With_Extras --
7415 -----------------------------
7417 function Next_Formal_With_Extras
(Id
: E
) return E
is
7419 if Present
(Extra_Formal
(Id
)) then
7420 return Extra_Formal
(Id
);
7422 return Next_Formal
(Id
);
7424 end Next_Formal_With_Extras
;
7430 function Next_Index
(Id
: Node_Id
) return Node_Id
is
7439 function Next_Literal
(Id
: E
) return E
is
7441 pragma Assert
(Nkind
(Id
) in N_Entity
);
7445 ------------------------------
7446 -- Next_Stored_Discriminant --
7447 ------------------------------
7449 function Next_Stored_Discriminant
(Id
: E
) return E
is
7451 -- See comment in Next_Discriminant
7453 return Next_Discriminant
(Id
);
7454 end Next_Stored_Discriminant
;
7456 -----------------------
7457 -- Number_Dimensions --
7458 -----------------------
7460 function Number_Dimensions
(Id
: E
) return Pos
is
7465 if Ekind
(Id
) in String_Kind
then
7470 T
:= First_Index
(Id
);
7471 while Present
(T
) loop
7478 end Number_Dimensions
;
7480 --------------------
7481 -- Number_Entries --
7482 --------------------
7484 function Number_Entries
(Id
: E
) return Nat
is
7489 pragma Assert
(Is_Concurrent_Type
(Id
));
7492 Ent
:= First_Entity
(Id
);
7493 while Present
(Ent
) loop
7494 if Is_Entry
(Ent
) then
7498 Ent
:= Next_Entity
(Ent
);
7504 --------------------
7505 -- Number_Formals --
7506 --------------------
7508 function Number_Formals
(Id
: E
) return Pos
is
7514 Formal
:= First_Formal
(Id
);
7515 while Present
(Formal
) loop
7517 Formal
:= Next_Formal
(Formal
);
7523 --------------------
7524 -- Parameter_Mode --
7525 --------------------
7527 function Parameter_Mode
(Id
: E
) return Formal_Kind
is
7532 ------------------------
7533 -- Predicate_Function --
7534 ------------------------
7536 function Predicate_Function
(Id
: E
) return E
is
7541 pragma Assert
(Is_Type
(Id
));
7543 -- If type is private and has a completion, predicate may be defined
7544 -- on the full view.
7546 if Is_Private_Type
(Id
) and then Present
(Full_View
(Id
)) then
7547 T
:= Full_View
(Id
);
7552 if No
(Subprograms_For_Type
(T
)) then
7556 S
:= Subprograms_For_Type
(T
);
7557 while Present
(S
) loop
7558 if Is_Predicate_Function
(S
) then
7561 S
:= Subprograms_For_Type
(S
);
7567 end Predicate_Function
;
7569 --------------------------
7570 -- Predicate_Function_M --
7571 --------------------------
7573 function Predicate_Function_M
(Id
: E
) return E
is
7578 pragma Assert
(Is_Type
(Id
));
7580 -- If type is private and has a completion, predicate may be defined
7581 -- on the full view.
7583 if Is_Private_Type
(Id
) and then Present
(Full_View
(Id
)) then
7584 T
:= Full_View
(Id
);
7589 if No
(Subprograms_For_Type
(T
)) then
7593 S
:= Subprograms_For_Type
(T
);
7594 while Present
(S
) loop
7595 if Is_Predicate_Function_M
(S
) then
7598 S
:= Subprograms_For_Type
(S
);
7604 end Predicate_Function_M
;
7606 -------------------------
7607 -- Present_In_Rep_Item --
7608 -------------------------
7610 function Present_In_Rep_Item
(E
: Entity_Id
; N
: Node_Id
) return Boolean is
7614 Ritem
:= First_Rep_Item
(E
);
7616 while Present
(Ritem
) loop
7621 Next_Rep_Item
(Ritem
);
7625 end Present_In_Rep_Item
;
7627 --------------------------
7628 -- Primitive_Operations --
7629 --------------------------
7631 function Primitive_Operations
(Id
: E
) return L
is
7633 if Is_Concurrent_Type
(Id
) then
7634 if Present
(Corresponding_Record_Type
(Id
)) then
7635 return Direct_Primitive_Operations
7636 (Corresponding_Record_Type
(Id
));
7638 -- If expansion is disabled the corresponding record type is absent,
7639 -- but if the type has ancestors it may have primitive operations.
7641 elsif Is_Tagged_Type
(Id
) then
7642 return Direct_Primitive_Operations
(Id
);
7648 return Direct_Primitive_Operations
(Id
);
7650 end Primitive_Operations
;
7652 ---------------------
7653 -- Record_Rep_Item --
7654 ---------------------
7656 procedure Record_Rep_Item
(E
: Entity_Id
; N
: Node_Id
) is
7658 Set_Next_Rep_Item
(N
, First_Rep_Item
(E
));
7659 Set_First_Rep_Item
(E
, N
);
7660 end Record_Rep_Item
;
7666 function Root_Type
(Id
: E
) return E
is
7670 pragma Assert
(Nkind
(Id
) in N_Entity
);
7672 T
:= Base_Type
(Id
);
7674 if Ekind
(T
) = E_Class_Wide_Type
then
7686 -- Following test catches some error cases resulting from
7689 elsif No
(Etyp
) then
7690 Check_Error_Detected
;
7693 elsif Is_Private_Type
(T
) and then Etyp
= Full_View
(T
) then
7696 elsif Is_Private_Type
(Etyp
) and then Full_View
(Etyp
) = T
then
7702 -- Return if there is a circularity in the inheritance chain. This
7703 -- happens in some error situations and we do not want to get
7704 -- stuck in this loop.
7706 if T
= Base_Type
(Id
) then
7713 ---------------------
7714 -- Safe_Emax_Value --
7715 ---------------------
7717 function Safe_Emax_Value
(Id
: E
) return Uint
is
7719 return Machine_Emax_Value
(Id
);
7720 end Safe_Emax_Value
;
7722 ----------------------
7723 -- Safe_First_Value --
7724 ----------------------
7726 function Safe_First_Value
(Id
: E
) return Ureal
is
7728 return -Safe_Last_Value
(Id
);
7729 end Safe_First_Value
;
7731 ---------------------
7732 -- Safe_Last_Value --
7733 ---------------------
7735 function Safe_Last_Value
(Id
: E
) return Ureal
is
7736 Radix
: constant Uint
:= Machine_Radix_Value
(Id
);
7737 Mantissa
: constant Uint
:= Machine_Mantissa_Value
(Id
);
7738 Emax
: constant Uint
:= Safe_Emax_Value
(Id
);
7739 Significand
: constant Uint
:= Radix
** Mantissa
- 1;
7740 Exponent
: constant Uint
:= Emax
- Mantissa
;
7746 (Num
=> Significand
* 2 ** (Exponent
mod 4),
7747 Den
=> -Exponent
/ 4,
7753 (Num
=> Significand
,
7757 end Safe_Last_Value
;
7763 function Scope_Depth
(Id
: E
) return Uint
is
7768 while Is_Record_Type
(Scop
) loop
7769 Scop
:= Scope
(Scop
);
7772 return Scope_Depth_Value
(Scop
);
7775 ---------------------
7776 -- Scope_Depth_Set --
7777 ---------------------
7779 function Scope_Depth_Set
(Id
: E
) return B
is
7781 return not Is_Record_Type
(Id
)
7782 and then Field22
(Id
) /= Union_Id
(Empty
);
7783 end Scope_Depth_Set
;
7785 -----------------------------
7786 -- Set_Component_Alignment --
7787 -----------------------------
7789 -- Component Alignment is encoded using two flags, Flag128/129 as
7790 -- follows. Note that both flags False = Align_Default, so that the
7791 -- default initialization of flags to False initializes component
7792 -- alignment to the default value as required.
7794 -- Flag128 Flag129 Value
7795 -- ------- ------- -----
7796 -- False False Calign_Default
7797 -- False True Calign_Component_Size
7798 -- True False Calign_Component_Size_4
7799 -- True True Calign_Storage_Unit
7801 procedure Set_Component_Alignment
(Id
: E
; V
: C
) is
7803 pragma Assert
((Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
7804 and then Is_Base_Type
(Id
));
7807 when Calign_Default
=>
7808 Set_Flag128
(Id
, False);
7809 Set_Flag129
(Id
, False);
7811 when Calign_Component_Size
=>
7812 Set_Flag128
(Id
, False);
7813 Set_Flag129
(Id
, True);
7815 when Calign_Component_Size_4
=>
7816 Set_Flag128
(Id
, True);
7817 Set_Flag129
(Id
, False);
7819 when Calign_Storage_Unit
=>
7820 Set_Flag128
(Id
, True);
7821 Set_Flag129
(Id
, True);
7823 end Set_Component_Alignment
;
7825 -----------------------------
7826 -- Set_Invariant_Procedure --
7827 -----------------------------
7829 procedure Set_Invariant_Procedure
(Id
: E
; V
: E
) is
7833 pragma Assert
(Is_Type
(Id
) and then Has_Invariants
(Id
));
7835 S
:= Subprograms_For_Type
(Id
);
7836 Set_Subprograms_For_Type
(Id
, V
);
7837 Set_Subprograms_For_Type
(V
, S
);
7839 -- Check for duplicate entry
7841 while Present
(S
) loop
7842 if Is_Invariant_Procedure
(S
) then
7843 raise Program_Error
;
7845 S
:= Subprograms_For_Type
(S
);
7848 end Set_Invariant_Procedure
;
7850 ----------------------------
7851 -- Set_Predicate_Function --
7852 ----------------------------
7854 procedure Set_Predicate_Function
(Id
: E
; V
: E
) is
7858 pragma Assert
(Is_Type
(Id
) and then Has_Predicates
(Id
));
7860 S
:= Subprograms_For_Type
(Id
);
7861 Set_Subprograms_For_Type
(Id
, V
);
7862 Set_Subprograms_For_Type
(V
, S
);
7864 while Present
(S
) loop
7865 if Is_Predicate_Function
(S
) then
7866 raise Program_Error
;
7868 S
:= Subprograms_For_Type
(S
);
7871 end Set_Predicate_Function
;
7873 ------------------------------
7874 -- Set_Predicate_Function_M --
7875 ------------------------------
7877 procedure Set_Predicate_Function_M
(Id
: E
; V
: E
) is
7881 pragma Assert
(Is_Type
(Id
) and then Has_Predicates
(Id
));
7883 S
:= Subprograms_For_Type
(Id
);
7884 Set_Subprograms_For_Type
(Id
, V
);
7885 Set_Subprograms_For_Type
(V
, S
);
7887 -- Check for duplicates
7889 while Present
(S
) loop
7890 if Is_Predicate_Function_M
(S
) then
7891 raise Program_Error
;
7893 S
:= Subprograms_For_Type
(S
);
7896 end Set_Predicate_Function_M
;
7902 function Size_Clause
(Id
: E
) return N
is
7904 return Get_Attribute_Definition_Clause
(Id
, Attribute_Size
);
7907 ------------------------
7908 -- Stream_Size_Clause --
7909 ------------------------
7911 function Stream_Size_Clause
(Id
: E
) return N
is
7913 return Get_Attribute_Definition_Clause
(Id
, Attribute_Stream_Size
);
7914 end Stream_Size_Clause
;
7920 function Subtype_Kind
(K
: Entity_Kind
) return Entity_Kind
is
7926 Kind
:= E_Access_Subtype
;
7930 Kind
:= E_Array_Subtype
;
7932 when E_Class_Wide_Type |
7933 E_Class_Wide_Subtype
=>
7934 Kind
:= E_Class_Wide_Subtype
;
7936 when E_Decimal_Fixed_Point_Type |
7937 E_Decimal_Fixed_Point_Subtype
=>
7938 Kind
:= E_Decimal_Fixed_Point_Subtype
;
7940 when E_Ordinary_Fixed_Point_Type |
7941 E_Ordinary_Fixed_Point_Subtype
=>
7942 Kind
:= E_Ordinary_Fixed_Point_Subtype
;
7944 when E_Private_Type |
7945 E_Private_Subtype
=>
7946 Kind
:= E_Private_Subtype
;
7948 when E_Limited_Private_Type |
7949 E_Limited_Private_Subtype
=>
7950 Kind
:= E_Limited_Private_Subtype
;
7952 when E_Record_Type_With_Private |
7953 E_Record_Subtype_With_Private
=>
7954 Kind
:= E_Record_Subtype_With_Private
;
7956 when E_Record_Type |
7958 Kind
:= E_Record_Subtype
;
7960 when E_String_Type |
7962 Kind
:= E_String_Subtype
;
7964 when Enumeration_Kind
=>
7965 Kind
:= E_Enumeration_Subtype
;
7968 Kind
:= E_Floating_Point_Subtype
;
7970 when Signed_Integer_Kind
=>
7971 Kind
:= E_Signed_Integer_Subtype
;
7973 when Modular_Integer_Kind
=>
7974 Kind
:= E_Modular_Integer_Subtype
;
7976 when Protected_Kind
=>
7977 Kind
:= E_Protected_Subtype
;
7980 Kind
:= E_Task_Subtype
;
7984 raise Program_Error
;
7990 ---------------------
7991 -- Type_High_Bound --
7992 ---------------------
7994 function Type_High_Bound
(Id
: E
) return Node_Id
is
7995 Rng
: constant Node_Id
:= Scalar_Range
(Id
);
7997 if Nkind
(Rng
) = N_Subtype_Indication
then
7998 return High_Bound
(Range_Expression
(Constraint
(Rng
)));
8000 return High_Bound
(Rng
);
8002 end Type_High_Bound
;
8004 --------------------
8005 -- Type_Low_Bound --
8006 --------------------
8008 function Type_Low_Bound
(Id
: E
) return Node_Id
is
8009 Rng
: constant Node_Id
:= Scalar_Range
(Id
);
8011 if Nkind
(Rng
) = N_Subtype_Indication
then
8012 return Low_Bound
(Range_Expression
(Constraint
(Rng
)));
8014 return Low_Bound
(Rng
);
8018 ---------------------
8019 -- Underlying_Type --
8020 ---------------------
8022 function Underlying_Type
(Id
: E
) return E
is
8024 -- For record_with_private the underlying type is always the direct
8025 -- full view. Never try to take the full view of the parent it
8026 -- doesn't make sense.
8028 if Ekind
(Id
) = E_Record_Type_With_Private
then
8029 return Full_View
(Id
);
8031 elsif Ekind
(Id
) in Incomplete_Or_Private_Kind
then
8033 -- If we have an incomplete or private type with a full view,
8034 -- then we return the Underlying_Type of this full view
8036 if Present
(Full_View
(Id
)) then
8037 if Id
= Full_View
(Id
) then
8039 -- Previous error in declaration
8044 return Underlying_Type
(Full_View
(Id
));
8047 -- If we have an incomplete entity that comes from the limited
8048 -- view then we return the Underlying_Type of its non-limited
8051 elsif From_Limited_With
(Id
)
8052 and then Present
(Non_Limited_View
(Id
))
8054 return Underlying_Type
(Non_Limited_View
(Id
));
8056 -- Otherwise check for the case where we have a derived type or
8057 -- subtype, and if so get the Underlying_Type of the parent type.
8059 elsif Etype
(Id
) /= Id
then
8060 return Underlying_Type
(Etype
(Id
));
8062 -- Otherwise we have an incomplete or private type that has
8063 -- no full view, which means that we have not encountered the
8064 -- completion, so return Empty to indicate the underlying type
8065 -- is not yet known.
8071 -- For non-incomplete, non-private types, return the type itself
8072 -- Also for entities that are not types at all return the entity
8078 end Underlying_Type
;
8084 function Vax_Float
(Id
: E
) return B
is
8086 return Is_Floating_Point_Type
(Id
) and then Float_Rep
(Id
) = VAX_Native
;
8089 ------------------------
8090 -- Write_Entity_Flags --
8091 ------------------------
8093 procedure Write_Entity_Flags
(Id
: Entity_Id
; Prefix
: String) is
8095 procedure W
(Flag_Name
: String; Flag
: Boolean);
8096 -- Write out given flag if it is set
8102 procedure W
(Flag_Name
: String; Flag
: Boolean) is
8106 Write_Str
(Flag_Name
);
8107 Write_Str
(" = True");
8112 -- Start of processing for Write_Entity_Flags
8115 if (Is_Array_Type
(Id
) or else Is_Record_Type
(Id
))
8116 and then Is_Base_Type
(Id
)
8119 Write_Str
("Component_Alignment = ");
8121 case Component_Alignment
(Id
) is
8122 when Calign_Default
=>
8123 Write_Str
("Calign_Default");
8125 when Calign_Component_Size
=>
8126 Write_Str
("Calign_Component_Size");
8128 when Calign_Component_Size_4
=>
8129 Write_Str
("Calign_Component_Size_4");
8131 when Calign_Storage_Unit
=>
8132 Write_Str
("Calign_Storage_Unit");
8138 W
("Address_Taken", Flag104
(Id
));
8139 W
("Body_Needed_For_SAL", Flag40
(Id
));
8140 W
("C_Pass_By_Copy", Flag125
(Id
));
8141 W
("Can_Never_Be_Null", Flag38
(Id
));
8142 W
("Checks_May_Be_Suppressed", Flag31
(Id
));
8143 W
("Debug_Info_Off", Flag166
(Id
));
8144 W
("Default_Expressions_Processed", Flag108
(Id
));
8145 W
("Delay_Cleanups", Flag114
(Id
));
8146 W
("Delay_Subprogram_Descriptors", Flag50
(Id
));
8147 W
("Depends_On_Private", Flag14
(Id
));
8148 W
("Discard_Names", Flag88
(Id
));
8149 W
("Elaboration_Entity_Required", Flag174
(Id
));
8150 W
("Elaborate_Body_Desirable", Flag210
(Id
));
8151 W
("Entry_Accepted", Flag152
(Id
));
8152 W
("Can_Use_Internal_Rep", Flag229
(Id
));
8153 W
("Finalize_Storage_Only", Flag158
(Id
));
8154 W
("From_Limited_With", Flag159
(Id
));
8155 W
("Has_Aliased_Components", Flag135
(Id
));
8156 W
("Has_Alignment_Clause", Flag46
(Id
));
8157 W
("Has_All_Calls_Remote", Flag79
(Id
));
8158 W
("Has_Anonymous_Master", Flag253
(Id
));
8159 W
("Has_Atomic_Components", Flag86
(Id
));
8160 W
("Has_Biased_Representation", Flag139
(Id
));
8161 W
("Has_Completion", Flag26
(Id
));
8162 W
("Has_Completion_In_Body", Flag71
(Id
));
8163 W
("Has_Complex_Representation", Flag140
(Id
));
8164 W
("Has_Component_Size_Clause", Flag68
(Id
));
8165 W
("Has_Contiguous_Rep", Flag181
(Id
));
8166 W
("Has_Controlled_Component", Flag43
(Id
));
8167 W
("Has_Controlling_Result", Flag98
(Id
));
8168 W
("Has_Convention_Pragma", Flag119
(Id
));
8169 W
("Has_Default_Aspect", Flag39
(Id
));
8170 W
("Has_Delayed_Aspects", Flag200
(Id
));
8171 W
("Has_Delayed_Freeze", Flag18
(Id
));
8172 W
("Has_Delayed_Rep_Aspects", Flag261
(Id
));
8173 W
("Has_Discriminants", Flag5
(Id
));
8174 W
("Has_Dispatch_Table", Flag220
(Id
));
8175 W
("Has_Dynamic_Predicate_Aspect", Flag258
(Id
));
8176 W
("Has_Enumeration_Rep_Clause", Flag66
(Id
));
8177 W
("Has_Exit", Flag47
(Id
));
8178 W
("Has_External_Tag_Rep_Clause", Flag110
(Id
));
8179 W
("Has_Forward_Instantiation", Flag175
(Id
));
8180 W
("Has_Fully_Qualified_Name", Flag173
(Id
));
8181 W
("Has_Gigi_Rep_Item", Flag82
(Id
));
8182 W
("Has_Homonym", Flag56
(Id
));
8183 W
("Has_Implicit_Dereference", Flag251
(Id
));
8184 W
("Has_Inheritable_Invariants", Flag248
(Id
));
8185 W
("Has_Initial_Value", Flag219
(Id
));
8186 W
("Has_Invariants", Flag232
(Id
));
8187 W
("Has_Loop_Entry_Attributes", Flag260
(Id
));
8188 W
("Has_Machine_Radix_Clause", Flag83
(Id
));
8189 W
("Has_Master_Entity", Flag21
(Id
));
8190 W
("Has_Missing_Return", Flag142
(Id
));
8191 W
("Has_Nested_Block_With_Handler", Flag101
(Id
));
8192 W
("Has_Non_Standard_Rep", Flag75
(Id
));
8193 W
("Has_Object_Size_Clause", Flag172
(Id
));
8194 W
("Has_Per_Object_Constraint", Flag154
(Id
));
8195 W
("Has_Postconditions", Flag240
(Id
));
8196 W
("Has_Pragma_Controlled", Flag27
(Id
));
8197 W
("Has_Pragma_Elaborate_Body", Flag150
(Id
));
8198 W
("Has_Pragma_Inline", Flag157
(Id
));
8199 W
("Has_Pragma_Inline_Always", Flag230
(Id
));
8200 W
("Has_Pragma_No_Inline", Flag201
(Id
));
8201 W
("Has_Pragma_Ordered", Flag198
(Id
));
8202 W
("Has_Pragma_Pack", Flag121
(Id
));
8203 W
("Has_Pragma_Preelab_Init", Flag221
(Id
));
8204 W
("Has_Pragma_Pure", Flag203
(Id
));
8205 W
("Has_Pragma_Pure_Function", Flag179
(Id
));
8206 W
("Has_Pragma_Thread_Local_Storage", Flag169
(Id
));
8207 W
("Has_Pragma_Unmodified", Flag233
(Id
));
8208 W
("Has_Pragma_Unreferenced", Flag180
(Id
));
8209 W
("Has_Pragma_Unreferenced_Objects", Flag212
(Id
));
8210 W
("Has_Predicates", Flag250
(Id
));
8211 W
("Has_Primitive_Operations", Flag120
(Id
));
8212 W
("Has_Private_Ancestor", Flag151
(Id
));
8213 W
("Has_Private_Declaration", Flag155
(Id
));
8214 W
("Has_Qualified_Name", Flag161
(Id
));
8215 W
("Has_RACW", Flag214
(Id
));
8216 W
("Has_Record_Rep_Clause", Flag65
(Id
));
8217 W
("Has_Recursive_Call", Flag143
(Id
));
8218 W
("Has_Shift_Operator", Flag267
(Id
));
8219 W
("Has_Size_Clause", Flag29
(Id
));
8220 W
("Has_Small_Clause", Flag67
(Id
));
8221 W
("Has_Specified_Layout", Flag100
(Id
));
8222 W
("Has_Specified_Stream_Input", Flag190
(Id
));
8223 W
("Has_Specified_Stream_Output", Flag191
(Id
));
8224 W
("Has_Specified_Stream_Read", Flag192
(Id
));
8225 W
("Has_Specified_Stream_Write", Flag193
(Id
));
8226 W
("Has_Static_Discriminants", Flag211
(Id
));
8227 W
("Has_Static_Predicate_Aspect", Flag259
(Id
));
8228 W
("Has_Storage_Size_Clause", Flag23
(Id
));
8229 W
("Has_Stream_Size_Clause", Flag184
(Id
));
8230 W
("Has_Task", Flag30
(Id
));
8231 W
("Has_Thunks", Flag228
(Id
));
8232 W
("Has_Unchecked_Union", Flag123
(Id
));
8233 W
("Has_Unknown_Discriminants", Flag72
(Id
));
8234 W
("Has_Up_Level_Access", Flag215
(Id
));
8235 W
("Has_Visible_Refinement", Flag263
(Id
));
8236 W
("Has_Volatile_Components", Flag87
(Id
));
8237 W
("Has_Xref_Entry", Flag182
(Id
));
8238 W
("In_Package_Body", Flag48
(Id
));
8239 W
("In_Private_Part", Flag45
(Id
));
8240 W
("In_Use", Flag8
(Id
));
8241 W
("Is_AST_Entry", Flag132
(Id
));
8242 W
("Is_Abstract_Subprogram", Flag19
(Id
));
8243 W
("Is_Abstract_Type", Flag146
(Id
));
8244 W
("Is_Local_Anonymous_Access", Flag194
(Id
));
8245 W
("Is_Access_Constant", Flag69
(Id
));
8246 W
("Is_Ada_2005_Only", Flag185
(Id
));
8247 W
("Is_Ada_2012_Only", Flag199
(Id
));
8248 W
("Is_Aliased", Flag15
(Id
));
8249 W
("Is_Asynchronous", Flag81
(Id
));
8250 W
("Is_Atomic", Flag85
(Id
));
8251 W
("Is_Bit_Packed_Array", Flag122
(Id
));
8252 W
("Is_CPP_Class", Flag74
(Id
));
8253 W
("Is_Called", Flag102
(Id
));
8254 W
("Is_Character_Type", Flag63
(Id
));
8255 W
("Is_Child_Unit", Flag73
(Id
));
8256 W
("Is_Class_Wide_Equivalent_Type", Flag35
(Id
));
8257 W
("Is_Compilation_Unit", Flag149
(Id
));
8258 W
("Is_Completely_Hidden", Flag103
(Id
));
8259 W
("Is_Concurrent_Record_Type", Flag20
(Id
));
8260 W
("Is_Constr_Subt_For_UN_Aliased", Flag141
(Id
));
8261 W
("Is_Constr_Subt_For_U_Nominal", Flag80
(Id
));
8262 W
("Is_Constrained", Flag12
(Id
));
8263 W
("Is_Constructor", Flag76
(Id
));
8264 W
("Is_Controlled", Flag42
(Id
));
8265 W
("Is_Controlling_Formal", Flag97
(Id
));
8266 W
("Is_Descendent_Of_Address", Flag223
(Id
));
8267 W
("Is_Discrim_SO_Function", Flag176
(Id
));
8268 W
("Is_Discriminant_Check_Function", Flag264
(Id
));
8269 W
("Is_Dispatch_Table_Entity", Flag234
(Id
));
8270 W
("Is_Dispatching_Operation", Flag6
(Id
));
8271 W
("Is_Eliminated", Flag124
(Id
));
8272 W
("Is_Entry_Formal", Flag52
(Id
));
8273 W
("Is_Exported", Flag99
(Id
));
8274 W
("Is_First_Subtype", Flag70
(Id
));
8275 W
("Is_For_Access_Subtype", Flag118
(Id
));
8276 W
("Is_Formal_Subprogram", Flag111
(Id
));
8277 W
("Is_Frozen", Flag4
(Id
));
8278 W
("Is_Generic_Actual_Type", Flag94
(Id
));
8279 W
("Is_Generic_Instance", Flag130
(Id
));
8280 W
("Is_Generic_Type", Flag13
(Id
));
8281 W
("Is_Hidden", Flag57
(Id
));
8282 W
("Is_Hidden_Open_Scope", Flag171
(Id
));
8283 W
("Is_Immediately_Visible", Flag7
(Id
));
8284 W
("Is_Implementation_Defined", Flag254
(Id
));
8285 W
("Is_Imported", Flag24
(Id
));
8286 W
("Is_Inlined", Flag11
(Id
));
8287 W
("Is_Instantiated", Flag126
(Id
));
8288 W
("Is_Interface", Flag186
(Id
));
8289 W
("Is_Internal", Flag17
(Id
));
8290 W
("Is_Interrupt_Handler", Flag89
(Id
));
8291 W
("Is_Intrinsic_Subprogram", Flag64
(Id
));
8292 W
("Is_Invariant_Procedure", Flag257
(Id
));
8293 W
("Is_Itype", Flag91
(Id
));
8294 W
("Is_Known_Non_Null", Flag37
(Id
));
8295 W
("Is_Known_Null", Flag204
(Id
));
8296 W
("Is_Known_Valid", Flag170
(Id
));
8297 W
("Is_Limited_Composite", Flag106
(Id
));
8298 W
("Is_Limited_Interface", Flag197
(Id
));
8299 W
("Is_Limited_Record", Flag25
(Id
));
8300 W
("Is_Machine_Code_Subprogram", Flag137
(Id
));
8301 W
("Is_Non_Static_Subtype", Flag109
(Id
));
8302 W
("Is_Null_Init_Proc", Flag178
(Id
));
8303 W
("Is_Obsolescent", Flag153
(Id
));
8304 W
("Is_Only_Out_Parameter", Flag226
(Id
));
8305 W
("Is_Optional_Parameter", Flag134
(Id
));
8306 W
("Is_Package_Body_Entity", Flag160
(Id
));
8307 W
("Is_Packed", Flag51
(Id
));
8308 W
("Is_Packed_Array_Type", Flag138
(Id
));
8309 W
("Is_Potentially_Use_Visible", Flag9
(Id
));
8310 W
("Is_Predicate_Function", Flag255
(Id
));
8311 W
("Is_Predicate_Function_M", Flag256
(Id
));
8312 W
("Is_Preelaborated", Flag59
(Id
));
8313 W
("Is_Primitive", Flag218
(Id
));
8314 W
("Is_Primitive_Wrapper", Flag195
(Id
));
8315 W
("Is_Private_Composite", Flag107
(Id
));
8316 W
("Is_Private_Descendant", Flag53
(Id
));
8317 W
("Is_Private_Primitive", Flag245
(Id
));
8318 W
("Is_Processed_Transient", Flag252
(Id
));
8319 W
("Is_Public", Flag10
(Id
));
8320 W
("Is_Pure", Flag44
(Id
));
8321 W
("Is_Pure_Unit_Access_Type", Flag189
(Id
));
8322 W
("Is_RACW_Stub_Type", Flag244
(Id
));
8323 W
("Is_Raised", Flag224
(Id
));
8324 W
("Is_Remote_Call_Interface", Flag62
(Id
));
8325 W
("Is_Remote_Types", Flag61
(Id
));
8326 W
("Is_Renaming_Of_Object", Flag112
(Id
));
8327 W
("Is_Return_Object", Flag209
(Id
));
8328 W
("Is_Safe_To_Reevaluate", Flag249
(Id
));
8329 W
("Is_Shared_Passive", Flag60
(Id
));
8330 W
("Is_Statically_Allocated", Flag28
(Id
));
8331 W
("Is_Tag", Flag78
(Id
));
8332 W
("Is_Tagged_Type", Flag55
(Id
));
8333 W
("Is_Thunk", Flag225
(Id
));
8334 W
("Is_Trivial_Subprogram", Flag235
(Id
));
8335 W
("Is_True_Constant", Flag163
(Id
));
8336 W
("Is_Unchecked_Union", Flag117
(Id
));
8337 W
("Is_Underlying_Record_View", Flag246
(Id
));
8338 W
("Is_Unsigned_Type", Flag144
(Id
));
8339 W
("Is_VMS_Exception", Flag133
(Id
));
8340 W
("Is_Valued_Procedure", Flag127
(Id
));
8341 W
("Is_Visible_Formal", Flag206
(Id
));
8342 W
("Is_Visible_Lib_Unit", Flag116
(Id
));
8343 W
("Is_Volatile", Flag16
(Id
));
8344 W
("Itype_Printed", Flag202
(Id
));
8345 W
("Kill_Elaboration_Checks", Flag32
(Id
));
8346 W
("Kill_Range_Checks", Flag33
(Id
));
8347 W
("Known_To_Have_Preelab_Init", Flag207
(Id
));
8348 W
("Low_Bound_Tested", Flag205
(Id
));
8349 W
("Machine_Radix_10", Flag84
(Id
));
8350 W
("Materialize_Entity", Flag168
(Id
));
8351 W
("May_Inherit_Delayed_Rep_Aspects", Flag262
(Id
));
8352 W
("Must_Be_On_Byte_Boundary", Flag183
(Id
));
8353 W
("Must_Have_Preelab_Init", Flag208
(Id
));
8354 W
("Needs_Debug_Info", Flag147
(Id
));
8355 W
("Needs_No_Actuals", Flag22
(Id
));
8356 W
("Never_Set_In_Source", Flag115
(Id
));
8357 W
("No_Pool_Assigned", Flag131
(Id
));
8358 W
("No_Return", Flag113
(Id
));
8359 W
("No_Strict_Aliasing", Flag136
(Id
));
8360 W
("Non_Binary_Modulus", Flag58
(Id
));
8361 W
("Nonzero_Is_True", Flag162
(Id
));
8362 W
("OK_To_Rename", Flag247
(Id
));
8363 W
("OK_To_Reorder_Components", Flag239
(Id
));
8364 W
("Optimize_Alignment_Space", Flag241
(Id
));
8365 W
("Optimize_Alignment_Time", Flag242
(Id
));
8366 W
("Overlays_Constant", Flag243
(Id
));
8367 W
("Reachable", Flag49
(Id
));
8368 W
("Referenced", Flag156
(Id
));
8369 W
("Referenced_As_LHS", Flag36
(Id
));
8370 W
("Referenced_As_Out_Parameter", Flag227
(Id
));
8371 W
("Renamed_In_Spec", Flag231
(Id
));
8372 W
("Requires_Overriding", Flag213
(Id
));
8373 W
("Return_Present", Flag54
(Id
));
8374 W
("Returns_By_Ref", Flag90
(Id
));
8375 W
("Reverse_Bit_Order", Flag164
(Id
));
8376 W
("Reverse_Storage_Order", Flag93
(Id
));
8377 W
("Sec_Stack_Needed_For_Return", Flag167
(Id
));
8378 W
("Size_Depends_On_Discriminant", Flag177
(Id
));
8379 W
("Size_Known_At_Compile_Time", Flag92
(Id
));
8380 W
("SPARK_Aux_Pragma_Inherited", Flag266
(Id
));
8381 W
("SPARK_Pragma_Inherited", Flag265
(Id
));
8382 W
("Static_Elaboration_Desired", Flag77
(Id
));
8383 W
("Strict_Alignment", Flag145
(Id
));
8384 W
("Suppress_Elaboration_Warnings", Flag148
(Id
));
8385 W
("Suppress_Initialization", Flag105
(Id
));
8386 W
("Suppress_Style_Checks", Flag165
(Id
));
8387 W
("Suppress_Value_Tracking_On_Call", Flag217
(Id
));
8388 W
("Treat_As_Volatile", Flag41
(Id
));
8389 W
("Universal_Aliasing", Flag216
(Id
));
8390 W
("Used_As_Generic_Actual", Flag222
(Id
));
8391 W
("Uses_Sec_Stack", Flag95
(Id
));
8392 W
("Warnings_Off", Flag96
(Id
));
8393 W
("Warnings_Off_Used", Flag236
(Id
));
8394 W
("Warnings_Off_Used_Unmodified", Flag237
(Id
));
8395 W
("Warnings_Off_Used_Unreferenced", Flag238
(Id
));
8396 W
("Was_Hidden", Flag196
(Id
));
8397 end Write_Entity_Flags
;
8399 -----------------------
8400 -- Write_Entity_Info --
8401 -----------------------
8403 procedure Write_Entity_Info
(Id
: Entity_Id
; Prefix
: String) is
8405 procedure Write_Attribute
(Which
: String; Nam
: E
);
8406 -- Write attribute value with given string name
8408 procedure Write_Kind
(Id
: Entity_Id
);
8409 -- Write Ekind field of entity
8411 ---------------------
8412 -- Write_Attribute --
8413 ---------------------
8415 procedure Write_Attribute
(Which
: String; Nam
: E
) is
8419 Write_Int
(Int
(Nam
));
8421 Write_Name
(Chars
(Nam
));
8423 end Write_Attribute
;
8429 procedure Write_Kind
(Id
: Entity_Id
) is
8430 K
: constant String := Entity_Kind
'Image (Ekind
(Id
));
8434 Write_Str
(" Kind ");
8436 if Is_Type
(Id
) and then Is_Tagged_Type
(Id
) then
8437 Write_Str
("TAGGED ");
8440 Write_Str
(K
(3 .. K
'Length));
8443 if Is_Type
(Id
) and then Depends_On_Private
(Id
) then
8444 Write_Str
("Depends_On_Private ");
8448 -- Start of processing for Write_Entity_Info
8452 Write_Attribute
("Name ", Id
);
8453 Write_Int
(Int
(Id
));
8457 Write_Attribute
(" Type ", Etype
(Id
));
8459 Write_Attribute
(" Scope ", Scope
(Id
));
8464 when Discrete_Kind
=>
8465 Write_Str
("Bounds: Id = ");
8467 if Present
(Scalar_Range
(Id
)) then
8468 Write_Int
(Int
(Type_Low_Bound
(Id
)));
8469 Write_Str
(" .. Id = ");
8470 Write_Int
(Int
(Type_High_Bound
(Id
)));
8472 Write_Str
("Empty");
8483 (" Component Type ", Component_Type
(Id
));
8486 Write_Str
(" Indexes ");
8488 Index
:= First_Index
(Id
);
8489 while Present
(Index
) loop
8490 Write_Attribute
(" ", Etype
(Index
));
8491 Index
:= Next_Index
(Index
);
8499 (" Directly Designated Type ",
8500 Directly_Designated_Type
(Id
));
8503 when Overloadable_Kind
=>
8504 if Present
(Homonym
(Id
)) then
8505 Write_Str
(" Homonym ");
8506 Write_Name
(Chars
(Homonym
(Id
)));
8508 Write_Int
(Int
(Homonym
(Id
)));
8515 if Ekind
(Scope
(Id
)) in Record_Kind
then
8517 " Original_Record_Component ",
8518 Original_Record_Component
(Id
));
8519 Write_Int
(Int
(Original_Record_Component
(Id
)));
8523 when others => null;
8525 end Write_Entity_Info
;
8527 -----------------------
8528 -- Write_Field6_Name --
8529 -----------------------
8531 procedure Write_Field6_Name
(Id
: Entity_Id
) is
8532 pragma Warnings
(Off
, Id
);
8534 Write_Str
("First_Rep_Item");
8535 end Write_Field6_Name
;
8537 -----------------------
8538 -- Write_Field7_Name --
8539 -----------------------
8541 procedure Write_Field7_Name
(Id
: Entity_Id
) is
8542 pragma Warnings
(Off
, Id
);
8544 Write_Str
("Freeze_Node");
8545 end Write_Field7_Name
;
8547 -----------------------
8548 -- Write_Field8_Name --
8549 -----------------------
8551 procedure Write_Field8_Name
(Id
: Entity_Id
) is
8555 Write_Str
("Associated_Node_For_Itype");
8558 Write_Str
("Dependent_Instances");
8561 Write_Str
("First_Exit_Statement");
8564 Write_Str
("Hiding_Loop_Variable");
8568 E_Subprogram_Body
=>
8569 Write_Str
("Mechanism");
8573 Write_Str
("Normalized_First_Bit");
8576 Write_Str
("Postcondition_Proc");
8578 when E_Abstract_State
=>
8579 Write_Str
("Refinement_Constituents");
8581 when E_Return_Statement
=>
8582 Write_Str
("Return_Applies_To");
8585 Write_Str
("Field8??");
8587 end Write_Field8_Name
;
8589 -----------------------
8590 -- Write_Field9_Name --
8591 -----------------------
8593 procedure Write_Field9_Name
(Id
: Entity_Id
) is
8597 Write_Str
("Class_Wide_Type");
8600 Write_Str
("Current_Value");
8602 when E_Abstract_State
=>
8603 Write_Str
("Part_Of_Constituents");
8606 E_Generic_Function |
8608 E_Generic_Procedure |
8611 Write_Str
("Renaming_Map");
8614 Write_Str
("Field9??");
8616 end Write_Field9_Name
;
8618 ------------------------
8619 -- Write_Field10_Name --
8620 ------------------------
8622 procedure Write_Field10_Name
(Id
: Entity_Id
) is
8625 when E_Abstract_State |
8627 Write_Str
("Encapsulating_State");
8629 when Class_Wide_Kind |
8635 Write_Str
("Direct_Primitive_Operations");
8638 Write_Str
("Float_Rep");
8640 when E_In_Parameter |
8642 Write_Str
("Discriminal_Link");
8648 Write_Str
("Handler_Records");
8652 Write_Str
("Normalized_Position_Max");
8655 Write_Str
("Field10??");
8657 end Write_Field10_Name
;
8659 ------------------------
8660 -- Write_Field11_Name --
8661 ------------------------
8663 procedure Write_Field11_Name
(Id
: Entity_Id
) is
8667 Write_Str
("Block_Node");
8671 Write_Str
("Component_Bit_Offset");
8674 Write_Str
("Entry_Component");
8676 when E_Enumeration_Literal
=>
8677 Write_Str
("Enumeration_Pos");
8681 Write_Str
("Full_View");
8683 when E_Generic_Package
=>
8684 Write_Str
("Generic_Homonym");
8687 Write_Str
("Last_Aggregate_Assignment");
8693 Write_Str
("Protected_Body_Subprogram");
8696 Write_Str
("Field11??");
8698 end Write_Field11_Name
;
8700 ------------------------
8701 -- Write_Field12_Name --
8702 ------------------------
8704 procedure Write_Field12_Name
(Id
: Entity_Id
) is
8708 Write_Str
("Associated_Formal_Package");
8711 Write_Str
("Barrier_Function");
8713 when E_Enumeration_Literal
=>
8714 Write_Str
("Enumeration_Rep");
8722 E_In_Out_Parameter |
8726 Write_Str
("Esize");
8730 Write_Str
("Next_Inlined_Subprogram");
8733 Write_Str
("Field12??");
8735 end Write_Field12_Name
;
8737 ------------------------
8738 -- Write_Field13_Name --
8739 ------------------------
8741 procedure Write_Field13_Name
(Id
: Entity_Id
) is
8746 Write_Str
("Component_Clause");
8749 Write_Str
("Elaboration_Entity");
8753 Generic_Unit_Kind
=>
8754 Write_Str
("Elaboration_Entity");
8758 Write_Str
("Extra_Accessibility");
8761 Write_Str
("RM_Size");
8764 Write_Str
("Field13??");
8766 end Write_Field13_Name
;
8768 -----------------------
8769 -- Write_Field14_Name --
8770 -----------------------
8772 procedure Write_Field14_Name
(Id
: Entity_Id
) is
8781 Write_Str
("Alignment");
8785 Write_Str
("First_Optional_Parameter");
8789 Write_Str
("Normalized_Position");
8792 E_Generic_Package
=>
8793 Write_Str
("Shadow_Entities");
8796 Write_Str
("Field14??");
8798 end Write_Field14_Name
;
8800 ------------------------
8801 -- Write_Field15_Name --
8802 ------------------------
8804 procedure Write_Field15_Name
(Id
: Entity_Id
) is
8807 when E_Discriminant
=>
8808 Write_Str
("Discriminant_Number");
8811 Write_Str
("DT_Entry_Count");
8815 Write_Str
("DT_Position");
8817 when E_Protected_Type
=>
8818 Write_Str
("Entry_Bodies_Array");
8821 Write_Str
("Entry_Parameters_Type");
8824 Write_Str
("Extra_Formal");
8826 when Enumeration_Kind
=>
8827 Write_Str
("Lit_Indexes");
8831 Write_Str
("Related_Instance");
8833 when Decimal_Fixed_Point_Kind
=>
8834 Write_Str
("Scale_Value");
8838 Write_Str
("Status_Flag_Or_Transient_Decl");
8842 Write_Str
("Storage_Size_Variable");
8844 when E_String_Literal_Subtype
=>
8845 Write_Str
("String_Literal_Low_Bound");
8848 Write_Str
("Field15??");
8850 end Write_Field15_Name
;
8852 ------------------------
8853 -- Write_Field16_Name --
8854 ------------------------
8856 procedure Write_Field16_Name
(Id
: Entity_Id
) is
8859 when E_Record_Type |
8860 E_Record_Type_With_Private
=>
8861 Write_Str
("Access_Disp_Table");
8863 when E_Abstract_State
=>
8864 Write_Str
("Body_References");
8866 when E_Record_Subtype |
8867 E_Class_Wide_Subtype
=>
8868 Write_Str
("Cloned_Subtype");
8872 Write_Str
("DTC_Entity");
8875 Write_Str
("Entry_Formal");
8880 Write_Str
("First_Private_Entity");
8882 when Enumeration_Kind
=>
8883 Write_Str
("Lit_Strings");
8885 when E_String_Literal_Subtype
=>
8886 Write_Str
("String_Literal_Length");
8890 Write_Str
("Unset_Reference");
8893 Write_Str
("Field16??");
8895 end Write_Field16_Name
;
8897 ------------------------
8898 -- Write_Field17_Name --
8899 ------------------------
8901 procedure Write_Field17_Name
(Id
: Entity_Id
) is
8906 E_Generic_In_Out_Parameter |
8908 Write_Str
("Actual_Subtype");
8911 Write_Str
("Digits_Value");
8913 when E_Discriminant
=>
8914 Write_Str
("Discriminal");
8923 E_Generic_Function |
8925 E_Generic_Procedure |
8933 E_Return_Statement |
8935 E_Subprogram_Type
=>
8936 Write_Str
("First_Entity");
8939 Write_Str
("First_Index");
8941 when Enumeration_Kind
=>
8942 Write_Str
("First_Literal");
8945 Write_Str
("Master_Id");
8947 when Modular_Integer_Kind
=>
8948 Write_Str
("Modulus");
8950 when E_Abstract_State |
8951 E_Incomplete_Type
=>
8952 Write_Str
("Non_Limited_View");
8954 when E_Incomplete_Subtype
=>
8955 if From_Limited_With
(Id
) then
8956 Write_Str
("Non_Limited_View");
8960 Write_Str
("Prival");
8963 Write_Str
("Field17??");
8965 end Write_Field17_Name
;
8967 ------------------------
8968 -- Write_Field18_Name --
8969 ------------------------
8971 procedure Write_Field18_Name
(Id
: Entity_Id
) is
8974 when E_Enumeration_Literal |
8978 Write_Str
("Alias");
8980 when E_Record_Type
=>
8981 Write_Str
("Corresponding_Concurrent_Type");
8983 when E_Subprogram_Body
=>
8984 Write_Str
("Corresponding_Protected_Entry");
8986 when Concurrent_Kind
=>
8987 Write_Str
("Corresponding_Record_Type");
8992 Write_Str
("Enclosing_Scope");
8994 when E_Entry_Index_Parameter
=>
8995 Write_Str
("Entry_Index_Constant");
8997 when E_Class_Wide_Subtype |
8998 E_Access_Protected_Subprogram_Type |
8999 E_Anonymous_Access_Protected_Subprogram_Type |
9000 E_Access_Subprogram_Type |
9002 Write_Str
("Equivalent_Type");
9004 when Fixed_Point_Kind
=>
9005 Write_Str
("Delta_Value");
9007 when Incomplete_Or_Private_Kind |
9009 Write_Str
("Private_Dependents");
9012 Write_Str
("Renamed_Object");
9016 E_Generic_Function |
9017 E_Generic_Procedure |
9018 E_Generic_Package
=>
9019 Write_Str
("Renamed_Entity");
9022 Write_Str
("Field18??");
9024 end Write_Field18_Name
;
9026 -----------------------
9027 -- Write_Field19_Name --
9028 -----------------------
9030 procedure Write_Field19_Name
(Id
: Entity_Id
) is
9034 E_Generic_Package
=>
9035 Write_Str
("Body_Entity");
9037 when E_Discriminant
=>
9038 Write_Str
("Corresponding_Discriminant");
9041 Write_Str
("Default_Aspect_Value");
9043 when E_Array_Type
=>
9044 Write_Str
("Default_Component_Value");
9046 when E_Record_Type
=>
9047 Write_Str
("Parent_Subtype");
9051 Write_Str
("Size_Check_Code");
9053 when E_Package_Body |
9055 Write_Str
("Spec_Entity");
9057 when Private_Kind
=>
9058 Write_Str
("Underlying_Full_View");
9060 when E_Function | E_Operator | E_Subprogram_Type
=>
9061 Write_Str
("Extra_Accessibility_Of_Result");
9064 Write_Str
("Field19??");
9066 end Write_Field19_Name
;
9068 -----------------------
9069 -- Write_Field20_Name --
9070 -----------------------
9072 procedure Write_Field20_Name
(Id
: Entity_Id
) is
9076 Write_Str
("Component_Type");
9078 when E_In_Parameter |
9079 E_Generic_In_Parameter
=>
9080 Write_Str
("Default_Value");
9083 Write_Str
("Directly_Designated_Type");
9086 Write_Str
("Discriminant_Checking_Func");
9088 when E_Discriminant
=>
9089 Write_Str
("Discriminant_Default_Value");
9098 E_Generic_Function |
9100 E_Generic_Procedure |
9108 E_Return_Statement |
9110 E_Subprogram_Type
=>
9111 Write_Str
("Last_Entity");
9115 Write_Str
("Prival_Link");
9118 Write_Str
("Scalar_Range");
9121 Write_Str
("Register_Exception_Call");
9124 Write_Str
("Field20??");
9126 end Write_Field20_Name
;
9128 -----------------------
9129 -- Write_Field21_Name --
9130 -----------------------
9132 procedure Write_Field21_Name
(Id
: Entity_Id
) is
9136 Write_Str
("Accept_Address");
9138 when E_In_Parameter
=>
9139 Write_Str
("Default_Expr_Function");
9141 when Concurrent_Kind |
9142 Incomplete_Or_Private_Kind |
9146 Write_Str
("Discriminant_Constraint");
9151 E_Generic_Function |
9153 E_Generic_Procedure |
9155 Write_Str
("Interface_Name");
9158 Modular_Integer_Kind
=>
9159 Write_Str
("Original_Array_Type");
9161 when Fixed_Point_Kind
=>
9162 Write_Str
("Small_Value");
9165 Write_Str
("Field21??");
9167 end Write_Field21_Name
;
9169 -----------------------
9170 -- Write_Field22_Name --
9171 -----------------------
9173 procedure Write_Field22_Name
(Id
: Entity_Id
) is
9177 Write_Str
("Associated_Storage_Pool");
9180 Write_Str
("Component_Size");
9182 when E_Record_Type
=>
9183 Write_Str
("Corresponding_Remote_Type");
9187 Write_Str
("Original_Record_Component");
9189 when E_Enumeration_Literal
=>
9190 Write_Str
("Enumeration_Rep_Expr");
9193 Write_Str
("Exception_Code");
9195 when E_Record_Type_With_Private |
9196 E_Record_Subtype_With_Private |
9199 E_Limited_Private_Type |
9200 E_Limited_Private_Subtype
=>
9201 Write_Str
("Private_View");
9204 Write_Str
("Protected_Formal");
9214 E_Generic_Function |
9215 E_Generic_Procedure |
9218 E_Return_Statement |
9221 Write_Str
("Scope_Depth_Value");
9224 Write_Str
("Shared_Var_Procs_Instance");
9227 Write_Str
("Field22??");
9229 end Write_Field22_Name
;
9231 ------------------------
9232 -- Write_Field23_Name --
9233 ------------------------
9235 procedure Write_Field23_Name
(Id
: Entity_Id
) is
9238 when E_Discriminant
=>
9239 Write_Str
("CR_Discriminant");
9242 Write_Str
("Entry_Cancel_Parameter");
9244 when E_Enumeration_Type
=>
9245 Write_Str
("Enum_Pos_To_Rep");
9249 Write_Str
("Extra_Constrained");
9252 Write_Str
("Finalization_Master");
9254 when E_Generic_Function |
9256 E_Generic_Procedure
=>
9257 Write_Str
("Inner_Instances");
9260 Write_Str
("Packed_Array_Type");
9263 Write_Str
("Protection_Object");
9265 when Concurrent_Kind |
9266 Incomplete_Or_Private_Kind |
9270 Write_Str
("Stored_Constraint");
9274 if Present
(Scope
(Id
))
9275 and then Is_Protected_Type
(Scope
(Id
))
9277 Write_Str
("Protection_Object");
9279 Write_Str
("Generic_Renamings");
9283 if Is_Generic_Instance
(Id
) then
9284 Write_Str
("Generic_Renamings");
9286 Write_Str
("Limited_View");
9290 Write_Str
("Field23??");
9292 end Write_Field23_Name
;
9294 ------------------------
9295 -- Write_Field24_Name --
9296 ------------------------
9298 procedure Write_Field24_Name
(Id
: Entity_Id
) is
9304 Write_Str
("Related_Expression");
9307 Write_Str
("Field24???");
9309 end Write_Field24_Name
;
9311 ------------------------
9312 -- Write_Field25_Name --
9313 ------------------------
9315 procedure Write_Field25_Name
(Id
: Entity_Id
) is
9318 when E_Generic_Package |
9320 Write_Str
("Abstract_States");
9323 Write_Str
("Debug_Renaming_Link");
9326 Write_Str
("DT_Offset_To_Top_Func");
9330 Write_Str
("Interface_Alias");
9332 when E_Record_Type |
9334 E_Record_Type_With_Private |
9335 E_Record_Subtype_With_Private
=>
9336 Write_Str
("Interfaces");
9340 Write_Str
("Related_Array_Object");
9343 Write_Str
("Task_Body_Procedure");
9347 Write_Str
("PPC_Wrapper");
9349 when E_Enumeration_Subtype |
9350 E_Modular_Integer_Subtype |
9351 E_Signed_Integer_Subtype
=>
9352 Write_Str
("Static_Predicate");
9355 Write_Str
("Field25??");
9357 end Write_Field25_Name
;
9359 ------------------------
9360 -- Write_Field26_Name --
9361 ------------------------
9363 procedure Write_Field26_Name
(Id
: Entity_Id
) is
9366 when E_Record_Type |
9367 E_Record_Type_With_Private
=>
9368 Write_Str
("Dispatch_Table_Wrappers");
9370 when E_In_Out_Parameter |
9373 Write_Str
("Last_Assignment");
9375 when E_Access_Subprogram_Type
=>
9376 Write_Str
("Original_Access_Type");
9378 when E_Generic_Package |
9380 Write_Str
("Package_Instantiation");
9384 Write_Str
("Related_Type");
9387 Write_Str
("Relative_Deadline_Variable");
9391 Write_Str
("Overridden_Operation");
9394 Write_Str
("Field26??");
9396 end Write_Field26_Name
;
9398 ------------------------
9399 -- Write_Field27_Name --
9400 ------------------------
9402 procedure Write_Field27_Name
(Id
: Entity_Id
) is
9407 Write_Str
("Current_Use_Clause");
9412 Write_Str
("Related_Type");
9416 Write_Str
("Wrapped_Entity");
9419 Write_Str
("Field27??");
9421 end Write_Field27_Name
;
9423 ------------------------
9424 -- Write_Field28_Name --
9425 ------------------------
9427 procedure Write_Field28_Name
(Id
: Entity_Id
) is
9435 E_Subprogram_Type
=>
9436 Write_Str
("Extra_Formals");
9440 Write_Str
("Finalizer");
9444 Write_Str
("Initialization_Statements");
9446 when E_Record_Type
=>
9447 Write_Str
("Underlying_Record_View");
9450 Write_Str
("Field28??");
9452 end Write_Field28_Name
;
9454 ------------------------
9455 -- Write_Field29_Name --
9456 ------------------------
9458 procedure Write_Field29_Name
(Id
: Entity_Id
) is
9463 Write_Str
("BIP_Initialization_Call");
9466 Write_Str
("Subprograms_For_Type");
9469 Write_Str
("Field29??");
9471 end Write_Field29_Name
;
9473 ------------------------
9474 -- Write_Field30_Name --
9475 ------------------------
9477 procedure Write_Field30_Name
(Id
: Entity_Id
) is
9481 Write_Str
("Corresponding_Equality");
9484 Write_Str
("Static_Initialization");
9487 Write_Str
("Field30??");
9489 end Write_Field30_Name
;
9491 ------------------------
9492 -- Write_Field31_Name --
9493 ------------------------
9495 procedure Write_Field31_Name
(Id
: Entity_Id
) is
9500 Write_Str
("Thunk_Entity");
9503 Write_Str
("Field31??");
9505 end Write_Field31_Name
;
9507 ------------------------
9508 -- Write_Field32_Name --
9509 ------------------------
9511 procedure Write_Field32_Name
(Id
: Entity_Id
) is
9515 E_Generic_Function |
9517 E_Generic_Procedure |
9521 E_Subprogram_Body
=>
9522 Write_Str
("SPARK_Pragma");
9525 Write_Str
("Field32??");
9527 end Write_Field32_Name
;
9529 ------------------------
9530 -- Write_Field33_Name --
9531 ------------------------
9533 procedure Write_Field33_Name
(Id
: Entity_Id
) is
9536 when E_Generic_Package |
9539 Write_Str
("SPARK_Aux_Pragma");
9545 Write_Str
("Linker_Section_Pragma");
9548 Write_Str
("Field33??");
9550 end Write_Field33_Name
;
9552 ------------------------
9553 -- Write_Field34_Name --
9554 ------------------------
9556 procedure Write_Field34_Name
(Id
: Entity_Id
) is
9566 Generic_Subprogram_Kind |
9568 Write_Str
("Contract");
9571 Write_Str
("Field34??");
9573 end Write_Field34_Name
;
9575 ------------------------
9576 -- Write_Field35_Name --
9577 ------------------------
9579 procedure Write_Field35_Name
(Id
: Entity_Id
) is
9582 when Subprogram_Kind
=>
9583 Write_Str
("Import_Pragma");
9585 Write_Str
("Field35??");
9587 end Write_Field35_Name
;
9589 -------------------------
9590 -- Iterator Procedures --
9591 -------------------------
9593 procedure Proc_Next_Component
(N
: in out Node_Id
) is
9595 N
:= Next_Component
(N
);
9596 end Proc_Next_Component
;
9598 procedure Proc_Next_Component_Or_Discriminant
(N
: in out Node_Id
) is
9600 N
:= Next_Entity
(N
);
9601 while Present
(N
) loop
9602 exit when Ekind_In
(N
, E_Component
, E_Discriminant
);
9603 N
:= Next_Entity
(N
);
9605 end Proc_Next_Component_Or_Discriminant
;
9607 procedure Proc_Next_Discriminant
(N
: in out Node_Id
) is
9609 N
:= Next_Discriminant
(N
);
9610 end Proc_Next_Discriminant
;
9612 procedure Proc_Next_Formal
(N
: in out Node_Id
) is
9614 N
:= Next_Formal
(N
);
9615 end Proc_Next_Formal
;
9617 procedure Proc_Next_Formal_With_Extras
(N
: in out Node_Id
) is
9619 N
:= Next_Formal_With_Extras
(N
);
9620 end Proc_Next_Formal_With_Extras
;
9622 procedure Proc_Next_Index
(N
: in out Node_Id
) is
9624 N
:= Next_Index
(N
);
9625 end Proc_Next_Index
;
9627 procedure Proc_Next_Inlined_Subprogram
(N
: in out Node_Id
) is
9629 N
:= Next_Inlined_Subprogram
(N
);
9630 end Proc_Next_Inlined_Subprogram
;
9632 procedure Proc_Next_Literal
(N
: in out Node_Id
) is
9634 N
:= Next_Literal
(N
);
9635 end Proc_Next_Literal
;
9637 procedure Proc_Next_Stored_Discriminant
(N
: in out Node_Id
) is
9639 N
:= Next_Stored_Discriminant
(N
);
9640 end Proc_Next_Stored_Discriminant
;