1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ A U X --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2022, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Package containing utility procedures used throughout the compiler.
-- Historical note. Many of the routines here were originally in Einfo, but
-- Einfo is supposed to be a relatively low level package dealing with the
-- content of entities in the tree, so this package is used for routines that
-- require more than minimal semantic knowledge.
with Alloc;
with Namet; use Namet;
with Table;
with Types; use Types;
package Sem_Aux is
--------------------------------
-- Obsolescent Warnings Table --
--------------------------------
-- This table records entities for which a pragma Obsolescent with a
-- message argument has been processed.
type OWT_Record is record
Ent : Entity_Id;
-- The entity to which the pragma applies
Msg : String_Id;
-- The string containing the message
end record;
package Obsolescent_Warnings is new Table.Table (
Table_Component_Type => OWT_Record,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Obsolescent_Warnings_Initial,
Table_Increment => Alloc.Obsolescent_Warnings_Increment,
Table_Name => "Obsolescent_Warnings");
procedure Initialize;
-- Called at the start of compilation of each new main source file to
-- initialize the allocation of the Obsolescent_Warnings table.
-----------------
-- Subprograms --
-----------------
function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id;
-- The argument Typ is a type or subtype entity. If the argument is a
-- subtype then it returns the subtype or type from which the subtype was
-- obtained, otherwise it returns Empty.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Available_View (Ent : Entity_Id) return Entity_Id;
-- Ent denotes an abstract state or a type that may come from a limited
-- with clause. Return the non-limited view of Ent if there is one or Ent
-- if this is not the case.
function Constant_Value (Ent : Entity_Id) return Node_Id;
-- Ent is a variable, constant, named integer, or named real entity. This
-- call obtains the initialization expression for the entity. Will return
-- Empty for a deferred constant whose full view is not available or
-- in some other cases of internal entities, which cannot be treated as
-- constants from the point of view of constant folding. Empty is also
-- returned for variables with no initialization expression.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Corresponding_Unsigned_Type (Typ : Entity_Id) return Entity_Id;
-- Typ is a signed integer subtype. This routine returns the standard
-- unsigned type with the same Esize as the implementation base type of
-- Typ, e.g. Long_Integer => Long_Unsigned.
function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- For any entity, Ent, returns the closest dynamic scope in which the
-- entity is declared or Standard_Standard for library-level entities.
function First_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. The discriminants are the first
-- entities declared in the type, so normally this is equivalent to
-- First_Entity. The exception arises for tagged types, where the tag
-- itself is prepended to the front of the entity chain, so the
-- First_Discriminant function steps past the tag if it is present.
-- The caller is responsible for checking that the type has discriminants.
-- When called on a private type with unknown discriminants, the function
-- always returns Empty.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id;
-- Typ is a type with discriminants. Gives the first discriminant stored
-- in an object of this type. In many cases, these are the same as the
-- normal visible discriminants for the type, but in the case of renamed
-- discriminants, this is not always the case.
--
-- For tagged types, and untagged types which are root types or derived
-- types but which do not rename discriminants in their root type, the
-- stored discriminants are the same as the actual discriminants of the
-- type, and hence this function is the same as First_Discriminant.
--
-- For derived untagged types that rename discriminants in the root type
-- this is the first of the discriminants that occur in the root type. To
-- be precise, in this case stored discriminants are entities attached to
-- the entity chain of the derived type which are a copy of the
-- discriminants of the root type. Furthermore their Is_Completely_Hidden
-- flag is set since although they are actually stored in the object, they
-- are not in the set of discriminants that is visible in the type.
--
-- For derived untagged types, the set of stored discriminants are the real
-- discriminants from Gigi's standpoint, i.e. those that will be stored in
-- actual objects of the type.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Subtype (Typ : Entity_Id) return Entity_Id;
-- Applies to all types and subtypes. For types, yields the first subtype
-- of the type. For subtypes, yields the first subtype of the base type of
-- the subtype.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function First_Tag_Component (Typ : Entity_Id) return Entity_Id;
-- Typ must be a tagged record type. This function returns the Entity for
-- the first _Tag field in the record type.
function Get_Called_Entity (Call : Node_Id) return Entity_Id;
-- Obtain the entity of the entry, operator, or subprogram being invoked
-- by call Call.
function Get_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- whose name matches the given name Nam. If Check_Parents is False then it
-- only returns rep item that has been directly specified for E (and not
-- inherited from its parents, if any). If one is found, it is returned,
-- otherwise Empty is returned. A special case is that when Nam is
-- Name_Priority, the call will also find Interrupt_Priority.
function Get_Rep_Item
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- whose name matches one of the given names Nam1 or Nam2. If Check_Parents
-- is False then it only returns rep item that has been directly specified
-- for E (and not inherited from its parents, if any). If one is found, it
-- is returned, otherwise Empty is returned. A special case is that when
-- one of the given names is Name_Priority, the call will also find
-- Interrupt_Priority.
function Get_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- representation pragma whose name matches the given name Nam. If
-- Check_Parents is False then it only returns representation pragma that
-- has been directly specified for E (and not inherited from its parents,
-- if any). If one is found and if it is the first rep item in the list
-- that matches Nam, it is returned, otherwise Empty is returned. A special
-- case is that when Nam is Name_Priority, the call will also find
-- Interrupt_Priority.
function Get_Rep_Pragma
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance of a
-- representation pragma whose name matches one of the given names Nam1 or
-- Nam2. If Check_Parents is False then it only returns representation
-- pragma that has been directly specified for E (and not inherited from
-- its parents, if any). If one is found and if it is the first rep item in
-- the list that matches one of the given names, it is returned, otherwise
-- Empty is returned. A special case is that when one of the given names is
-- Name_Priority, the call will also find Interrupt_Priority.
function Has_Rep_Item
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- with the given name Nam. If Check_Parents is False then it only checks
-- for a rep item that has been directly specified for E (and not inherited
-- from its parents, if any). If found then True is returned, otherwise
-- False indicates that no matching entry was found.
function Has_Rep_Item
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- rep item (pragma, attribute definition clause, or aspect specification)
-- with the given names Nam1 or Nam2. If Check_Parents is False then it
-- only checks for a rep item that has been directly specified for E (and
-- not inherited from its parents, if any). If found then True is returned,
-- otherwise False indicates that no matching entry was found.
function Has_Rep_Pragma
(E : Entity_Id;
Nam : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- representation pragma with the given name Nam. If Check_Parents is False
-- then it only checks for a representation pragma that has been directly
-- specified for E (and not inherited from its parents, if any). If found
-- and if it is the first rep item in the list that matches Nam then True
-- is returned, otherwise False indicates that no matching entry was found.
function Has_Rep_Pragma
(E : Entity_Id;
Nam1 : Name_Id;
Nam2 : Name_Id;
Check_Parents : Boolean := True) return Boolean;
-- Searches the Rep_Item chain for the given entity E, for an instance of a
-- representation pragma with the given names Nam1 or Nam2. If
-- Check_Parents is False then it only checks for a rep item that has been
-- directly specified for E (and not inherited from its parents, if any).
-- If found and if it is the first rep item in the list that matches one of
-- the given names then True is returned, otherwise False indicates that no
-- matching entry was found.
function Has_External_Tag_Rep_Clause (T : Entity_Id) return Boolean;
-- Defined in tagged types. Set if an External_Tag rep. clause has been
-- given for this type. Use to avoid the generation of the default
-- External_Tag.
--
-- Note: we used to use an entity flag for this purpose, but that was wrong
-- because it was not propagated from the private view to the full view. We
-- could have added that propagation, but it would have been an annoying
-- irregularity compared to other representation aspects, and the cost of
-- looking up the aspect when needed is small.
function Has_Unconstrained_Elements (T : Entity_Id) return Boolean;
-- True if T has discriminants and is unconstrained, or is an array type
-- whose element type Has_Unconstrained_Elements.
function Has_Variant_Part (Typ : Entity_Id) return Boolean;
-- Return True if the first subtype of Typ is a discriminated record type
-- which has a variant part. False otherwise.
function In_Generic_Body (Id : Entity_Id) return Boolean;
-- Determine whether entity Id appears inside a generic body
function Initialization_Suppressed (Typ : Entity_Id) return Boolean;
pragma Inline (Initialization_Suppressed);
-- Returns True if initialization should be suppressed for the given type
-- or subtype. This is true if Suppress_Initialization is set either for
-- the subtype itself, or for the corresponding base type.
function Is_Body (N : Node_Id) return Boolean with Inline;
-- Determine whether an arbitrary node denotes a body
function Is_By_Copy_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by copy, as defined in (RM 6.2(3)).
function Is_By_Reference_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by reference, as defined in (RM 6.2(4-9)).
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Is_Definite_Subtype (T : Entity_Id) return Boolean;
-- T is a type entity. Returns True if T is a definite subtype.
-- Indefinite subtypes are unconstrained arrays, unconstrained
-- discriminated types without defaulted discriminants, class-wide types,
-- and types with unknown discriminants. Definite subtypes are all others
-- (elementary, constrained composites (including the case of records
-- without discriminants), and types with defaulted discriminants).
function Is_Derived_Type (Ent : Entity_Id) return Boolean;
-- Determines if the given entity Ent is a derived type. Result is always
-- false if argument is not a type.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
function Is_Generic_Formal (E : Entity_Id) return Boolean;
-- Determine whether E is a generic formal parameter. In particular this is
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parameterization.
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean;
-- Implements definition in Ada 2012 RM-7.5 (8.1/3). This differs from the
-- following predicate in that an untagged record with immutably limited
-- components is NOT by itself immutably limited. This matters, e.g. when
-- checking the legality of an access to the current instance.
function Is_Limited_View (Ent : Entity_Id) return Boolean;
-- Ent is any entity. True for a type that is "inherently" limited (i.e.
-- cannot become nonlimited). From the Ada 2005 RM-7.5(8.1/2), "a type with
-- a part that is of a task, protected, or explicitly limited record type".
-- These are the types that are defined as return-by-reference types in Ada
-- 95 (see RM95-6.5(11-16)). In Ada 2005, these are the types that require
-- build-in-place for function calls. Note that build-in-place is allowed
-- for other types, too. This is also used for identifying pure procedures
-- whose calls should not be eliminated (RM 10.2.1(18/2)).
function Is_Limited_Type (Ent : Entity_Id) return Boolean;
-- Ent is any entity. Returns true if Ent is a limited type (limited
-- private type, limited interface type, task type, protected type,
-- composite containing a limited component, or a subtype of any of
-- these types). This older routine overlaps with the previous one, this
-- should be cleaned up???
function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id;
-- Given a subtype Typ, this function finds out the nearest ancestor from
-- which constraints and predicates are inherited. There is no simple link
-- for doing this, consider:
--
-- subtype R is Integer range 1 .. 10;
-- type T is new R;
--
-- In this case the nearest ancestor is R, but the Etype of T'Base will
-- point to R'Base, so we have to go rummaging in the declarations to get
-- this information. It is used for making sure we freeze this before we
-- freeze Typ, and also for retrieving inherited predicate information.
-- For the case of base types or first subtypes, there is no useful entity
-- to return, so Empty is returned.
--
-- Note: this is similar to Ancestor_Subtype except that it also deals
-- with the case of derived types.
function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id;
-- This is similar to Enclosing_Dynamic_Scope except that if Ent is itself
-- a dynamic scope, then it is returned. Otherwise the result is the same
-- as that returned by Enclosing_Dynamic_Scope.
function Next_Tag_Component (Tag : Entity_Id) return Entity_Id;
-- Tag must be an entity representing a _Tag field of a tagged record.
-- The result returned is the next _Tag field in this record, or Empty
-- if this is the last such field.
function Number_Discriminants (Typ : Entity_Id) return Pos;
-- Typ is a type with discriminants, yields number of discriminants in type
function Object_Type_Has_Constrained_Partial_View
(Typ : Entity_Id;
Scop : Entity_Id) return Boolean;
-- Return True if type of object has attribute Has_Constrained_Partial_View
-- set to True; in addition, within a generic body, return True if subtype
-- of the object is a descendant of an untagged generic formal private or
-- derived type, and the subtype is not an unconstrained array subtype
-- (RM 3.3(23.10/3)).
function Package_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a package, return the corresponding package body, if
-- any, or else Empty.
function Package_Spec (E : Entity_Id) return Node_Id;
-- Given an entity for a package spec, return the corresponding package
-- spec if any, or else Empty.
function Package_Specification (E : Entity_Id) return Node_Id;
-- Given an entity for a package, return the corresponding package
-- specification.
function Subprogram_Body (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram (spec or body), return the
-- corresponding subprogram body if any, or else Empty.
function Subprogram_Body_Entity (E : Entity_Id) return Entity_Id;
-- Given an entity for a subprogram (spec or body), return the entity
-- corresponding to the subprogram body, which may be the same as E or
-- Empty if no body is available.
function Subprogram_Spec (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram spec, return the corresponding
-- subprogram spec if any, or else Empty.
function Subprogram_Specification (E : Entity_Id) return Node_Id;
-- Given an entity for a subprogram, return the corresponding subprogram
-- specification. If the entity is an inherited subprogram without
-- specification itself, return the specification of the inherited
-- subprogram.
function Ultimate_Alias (Prim : Entity_Id) return Entity_Id;
pragma Inline (Ultimate_Alias);
-- Return the last entity in the chain of aliased entities of Prim. If Prim
-- has no alias return Prim.
function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id;
-- Unit_Id is the simple name of a program unit, this function returns the
-- corresponding xxx_Declaration node for the entity. Also applies to the
-- body entities for subprograms, tasks and protected units, in which case
-- it returns the subprogram, task or protected body node for it. The unit
-- may be a child unit with any number of ancestors.
end Sem_Aux;
|