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