summaryrefslogtreecommitdiff
path: root/gcc/ada/sem_aux.ads
blob: fafd70f7f457640e9e9a934bd09c33bea03ae076 (plain)
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
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                              S E M _ A U X                               --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--          Copyright (C) 1992-2012, 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.          --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public 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,
--  and also by ASIS so dependencies are limited to ASIS included packages.

--  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; use 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. Note that
   --  Initialize must not be called if Tree_Read is used.

   procedure Tree_Read;
   --  Initializes Obsolescent_Warnings table from current tree file using the
   --  relevant Table.Tree_Read routine.

   procedure Tree_Write;
   --  Writes out Obsolescent_Warnings table to current tree file using the
   --  relevant Table.Tree_Write routine.

   -----------------
   -- Subprograms --
   -----------------

   function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id;
   --  The argument Id 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.

   function Available_View (Typ : Entity_Id) return Entity_Id;
   --  Typ is typically a type that has the With_Type flag set. Returns the
   --  non-limited view of the type, if available, otherwise the type itself.
   --  For class-wide types, there is no direct link in the tree, so we have
   --  to retrieve the class-wide type of the non-limited view of the Etype.
   --  Returns the argument unchanged if it is not one of these cases.

   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.

   function Effectively_Has_Constrained_Partial_View
     (Typ  : Entity_Id;
      Scop : Entity_Id) return Boolean;
   --  Return True if Typ has attribute Has_Constrained_Partial_View set to
   --  True; in addition, within a generic body, return True if a subtype 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 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.

   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 non-tagged 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.

   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.

   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_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 In_Generic_Body (Id : Entity_Id) return Boolean;
   --  Determine whether entity Id appears inside a generic 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)).

   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.

   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 parametrization.

   function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean;
   --  Ent is any entity. Determines if given entity is an unconstrained array
   --  type or subtype, a discriminated record type or subtype with no initial
   --  discriminant values or a class wide type or subtype and returns True if
   --  so. False for other type entities, or any entities that are not types.

   function Is_Immutably_Limited_Type (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).

   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 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 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;