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-2012, 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; 45 46package Sem_Aux is 47 48 -------------------------------- 49 -- Obsolescent Warnings Table -- 50 -------------------------------- 51 52 -- This table records entities for which a pragma Obsolescent with a 53 -- message argument has been processed. 54 55 type OWT_Record is record 56 Ent : Entity_Id; 57 -- The entity to which the pragma applies 58 59 Msg : String_Id; 60 -- The string containing the message 61 end record; 62 63 package Obsolescent_Warnings is new Table.Table ( 64 Table_Component_Type => OWT_Record, 65 Table_Index_Type => Int, 66 Table_Low_Bound => 0, 67 Table_Initial => Alloc.Obsolescent_Warnings_Initial, 68 Table_Increment => Alloc.Obsolescent_Warnings_Increment, 69 Table_Name => "Obsolescent_Warnings"); 70 71 procedure Initialize; 72 -- Called at the start of compilation of each new main source file to 73 -- initialize the allocation of the Obsolescent_Warnings table. Note that 74 -- Initialize must not be called if Tree_Read is used. 75 76 procedure Tree_Read; 77 -- Initializes Obsolescent_Warnings table from current tree file using the 78 -- relevant Table.Tree_Read routine. 79 80 procedure Tree_Write; 81 -- Writes out Obsolescent_Warnings table to current tree file using the 82 -- relevant Table.Tree_Write routine. 83 84 ----------------- 85 -- Subprograms -- 86 ----------------- 87 88 function Ancestor_Subtype (Typ : Entity_Id) return Entity_Id; 89 -- The argument Id is a type or subtype entity. If the argument is a 90 -- subtype then it returns the subtype or type from which the subtype was 91 -- obtained, otherwise it returns Empty. 92 93 function Available_View (Typ : Entity_Id) return Entity_Id; 94 -- Typ is typically a type that has the With_Type flag set. Returns the 95 -- non-limited view of the type, if available, otherwise the type itself. 96 -- For class-wide types, there is no direct link in the tree, so we have 97 -- to retrieve the class-wide type of the non-limited view of the Etype. 98 -- Returns the argument unchanged if it is not one of these cases. 99 100 function Constant_Value (Ent : Entity_Id) return Node_Id; 101 -- Ent is a variable, constant, named integer, or named real entity. This 102 -- call obtains the initialization expression for the entity. Will return 103 -- Empty for a deferred constant whose full view is not available or 104 -- in some other cases of internal entities, which cannot be treated as 105 -- constants from the point of view of constant folding. Empty is also 106 -- returned for variables with no initialization expression. 107 108 function Effectively_Has_Constrained_Partial_View 109 (Typ : Entity_Id; 110 Scop : Entity_Id) return Boolean; 111 -- Return True if Typ has attribute Has_Constrained_Partial_View set to 112 -- True; in addition, within a generic body, return True if a subtype is 113 -- a descendant of an untagged generic formal private or derived type, and 114 -- the subtype is not an unconstrained array subtype (RM 3.3(23.10/3)). 115 116 function Enclosing_Dynamic_Scope (Ent : Entity_Id) return Entity_Id; 117 -- For any entity, Ent, returns the closest dynamic scope in which the 118 -- entity is declared or Standard_Standard for library-level entities. 119 120 function First_Discriminant (Typ : Entity_Id) return Entity_Id; 121 -- Typ is a type with discriminants. The discriminants are the first 122 -- entities declared in the type, so normally this is equivalent to 123 -- First_Entity. The exception arises for tagged types, where the tag 124 -- itself is prepended to the front of the entity chain, so the 125 -- First_Discriminant function steps past the tag if it is present. 126 127 function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id; 128 -- Typ is a type with discriminants. Gives the first discriminant stored 129 -- in an object of this type. In many cases, these are the same as the 130 -- normal visible discriminants for the type, but in the case of renamed 131 -- discriminants, this is not always the case. 132 -- 133 -- For tagged types, and untagged types which are root types or derived 134 -- types but which do not rename discriminants in their root type, the 135 -- stored discriminants are the same as the actual discriminants of the 136 -- type, and hence this function is the same as First_Discriminant. 137 -- 138 -- For derived non-tagged types that rename discriminants in the root type 139 -- this is the first of the discriminants that occur in the root type. To 140 -- be precise, in this case stored discriminants are entities attached to 141 -- the entity chain of the derived type which are a copy of the 142 -- discriminants of the root type. Furthermore their Is_Completely_Hidden 143 -- flag is set since although they are actually stored in the object, they 144 -- are not in the set of discriminants that is visible in the type. 145 -- 146 -- For derived untagged types, the set of stored discriminants are the real 147 -- discriminants from Gigi's standpoint, i.e. those that will be stored in 148 -- actual objects of the type. 149 150 function First_Subtype (Typ : Entity_Id) return Entity_Id; 151 -- Applies to all types and subtypes. For types, yields the first subtype 152 -- of the type. For subtypes, yields the first subtype of the base type of 153 -- the subtype. 154 155 function First_Tag_Component (Typ : Entity_Id) return Entity_Id; 156 -- Typ must be a tagged record type. This function returns the Entity for 157 -- the first _Tag field in the record type. 158 159 function Get_Rep_Item 160 (E : Entity_Id; 161 Nam : Name_Id; 162 Check_Parents : Boolean := True) return Node_Id; 163 -- Searches the Rep_Item chain for a given entity E, for an instance of a 164 -- rep item (pragma, attribute definition clause, or aspect specification) 165 -- whose name matches the given name Nam. If Check_Parents is False then it 166 -- only returns rep item that has been directly specified for E (and not 167 -- inherited from its parents, if any). If one is found, it is returned, 168 -- otherwise Empty is returned. A special case is that when Nam is 169 -- Name_Priority, the call will also find Interrupt_Priority. 170 171 function Get_Rep_Item 172 (E : Entity_Id; 173 Nam1 : Name_Id; 174 Nam2 : Name_Id; 175 Check_Parents : Boolean := True) return Node_Id; 176 -- Searches the Rep_Item chain for a given entity E, for an instance of a 177 -- rep item (pragma, attribute definition clause, or aspect specification) 178 -- whose name matches one of the given names Nam1 or Nam2. If Check_Parents 179 -- is False then it only returns rep item that has been directly specified 180 -- for E (and not inherited from its parents, if any). If one is found, it 181 -- is returned, otherwise Empty is returned. A special case is that when 182 -- one of the given names is Name_Priority, the call will also find 183 -- Interrupt_Priority. 184 185 function Get_Rep_Pragma 186 (E : Entity_Id; 187 Nam : Name_Id; 188 Check_Parents : Boolean := True) return Node_Id; 189 -- Searches the Rep_Item chain for a given entity E, for an instance of a 190 -- representation pragma whose name matches the given name Nam. If 191 -- Check_Parents is False then it only returns representation pragma that 192 -- has been directly specified for E (and not inherited from its parents, 193 -- if any). If one is found and if it is the first rep item in the list 194 -- that matches Nam, it is returned, otherwise Empty is returned. A special 195 -- case is that when Nam is Name_Priority, the call will also find 196 -- Interrupt_Priority. 197 198 function Get_Rep_Pragma 199 (E : Entity_Id; 200 Nam1 : Name_Id; 201 Nam2 : 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 one of the given names Nam1 or 205 -- Nam2. If Check_Parents is False then it only returns representation 206 -- pragma that has been directly specified for E (and not inherited from 207 -- its parents, if any). If one is found and if it is the first rep item in 208 -- the list that matches one of the given names, it is returned, otherwise 209 -- Empty is returned. A special case is that when one of the given names is 210 -- Name_Priority, the call will also find Interrupt_Priority. 211 212 function Has_Rep_Item 213 (E : Entity_Id; 214 Nam : Name_Id; 215 Check_Parents : Boolean := True) return Boolean; 216 -- Searches the Rep_Item chain for the given entity E, for an instance of a 217 -- rep item (pragma, attribute definition clause, or aspect specification) 218 -- with the given name Nam. If Check_Parents is False then it only checks 219 -- for a rep item that has been directly specified for E (and not inherited 220 -- from its parents, if any). If found then True is returned, otherwise 221 -- False indicates that no matching entry was found. 222 223 function Has_Rep_Item 224 (E : Entity_Id; 225 Nam1 : Name_Id; 226 Nam2 : Name_Id; 227 Check_Parents : Boolean := True) return Boolean; 228 -- Searches the Rep_Item chain for the given entity E, for an instance of a 229 -- rep item (pragma, attribute definition clause, or aspect specification) 230 -- with the given names Nam1 or Nam2. If Check_Parents is False then it 231 -- only checks for a rep item that has been directly specified for E (and 232 -- not inherited from its parents, if any). If found then True is returned, 233 -- otherwise False indicates that no matching entry was found. 234 235 function Has_Rep_Pragma 236 (E : Entity_Id; 237 Nam : Name_Id; 238 Check_Parents : Boolean := True) return Boolean; 239 -- Searches the Rep_Item chain for the given entity E, for an instance of a 240 -- representation pragma with the given name Nam. If Check_Parents is False 241 -- then it only checks for a representation pragma that has been directly 242 -- specified for E (and not inherited from its parents, if any). If found 243 -- and if it is the first rep item in the list that matches Nam then True 244 -- is returned, otherwise False indicates that no matching entry was found. 245 246 function Has_Rep_Pragma 247 (E : Entity_Id; 248 Nam1 : Name_Id; 249 Nam2 : Name_Id; 250 Check_Parents : Boolean := True) return Boolean; 251 -- Searches the Rep_Item chain for the given entity E, for an instance of a 252 -- representation pragma with the given names Nam1 or Nam2. If 253 -- Check_Parents is False then it only checks for a rep item that has been 254 -- directly specified for E (and not inherited from its parents, if any). 255 -- If found and if it is the first rep item in the list that matches one of 256 -- the given names then True is returned, otherwise False indicates that no 257 -- matching entry was found. 258 259 function In_Generic_Body (Id : Entity_Id) return Boolean; 260 -- Determine whether entity Id appears inside a generic body 261 262 function Is_By_Copy_Type (Ent : Entity_Id) return Boolean; 263 -- Ent is any entity. Returns True if Ent is a type entity where the type 264 -- is required to be passed by copy, as defined in (RM 6.2(3)). 265 266 function Is_By_Reference_Type (Ent : Entity_Id) return Boolean; 267 -- Ent is any entity. Returns True if Ent is a type entity where the type 268 -- is required to be passed by reference, as defined in (RM 6.2(4-9)). 269 270 function Is_Derived_Type (Ent : Entity_Id) return Boolean; 271 -- Determines if the given entity Ent is a derived type. Result is always 272 -- false if argument is not a type. 273 274 function Is_Generic_Formal (E : Entity_Id) return Boolean; 275 -- Determine whether E is a generic formal parameter. In particular this is 276 -- used to set the visibility of generic formals of a generic package 277 -- declared with a box or with partial parametrization. 278 279 function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean; 280 -- Ent is any entity. Determines if given entity is an unconstrained array 281 -- type or subtype, a discriminated record type or subtype with no initial 282 -- discriminant values or a class wide type or subtype and returns True if 283 -- so. False for other type entities, or any entities that are not types. 284 285 function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean; 286 -- Ent is any entity. True for a type that is "inherently" limited (i.e. 287 -- cannot become nonlimited). From the Ada 2005 RM-7.5(8.1/2), "a type with 288 -- a part that is of a task, protected, or explicitly limited record type". 289 -- These are the types that are defined as return-by-reference types in Ada 290 -- 95 (see RM95-6.5(11-16)). In Ada 2005, these are the types that require 291 -- build-in-place for function calls. Note that build-in-place is allowed 292 -- for other types, too. This is also used for identifying pure procedures 293 -- whose calls should not be eliminated (RM 10.2.1(18/2)). 294 295 function Is_Limited_Type (Ent : Entity_Id) return Boolean; 296 -- Ent is any entity. Returns true if Ent is a limited type (limited 297 -- private type, limited interface type, task type, protected type, 298 -- composite containing a limited component, or a subtype of any of 299 -- these types). 300 301 function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id; 302 -- Given a subtype Typ, this function finds out the nearest ancestor from 303 -- which constraints and predicates are inherited. There is no simple link 304 -- for doing this, consider: 305 -- 306 -- subtype R is Integer range 1 .. 10; 307 -- type T is new R; 308 -- 309 -- In this case the nearest ancestor is R, but the Etype of T'Base will 310 -- point to R'Base, so we have to go rummaging in the declarations to get 311 -- this information. It is used for making sure we freeze this before we 312 -- freeze Typ, and also for retrieving inherited predicate information. 313 -- For the case of base types or first subtypes, there is no useful entity 314 -- to return, so Empty is returned. 315 -- 316 -- Note: this is similar to Ancestor_Subtype except that it also deals 317 -- with the case of derived types. 318 319 function Nearest_Dynamic_Scope (Ent : Entity_Id) return Entity_Id; 320 -- This is similar to Enclosing_Dynamic_Scope except that if Ent is itself 321 -- a dynamic scope, then it is returned. Otherwise the result is the same 322 -- as that returned by Enclosing_Dynamic_Scope. 323 324 function Next_Tag_Component (Tag : Entity_Id) return Entity_Id; 325 -- Tag must be an entity representing a _Tag field of a tagged record. 326 -- The result returned is the next _Tag field in this record, or Empty 327 -- if this is the last such field. 328 329 function Number_Discriminants (Typ : Entity_Id) return Pos; 330 -- Typ is a type with discriminants, yields number of discriminants in type 331 332 function Initialization_Suppressed (Typ : Entity_Id) return Boolean; 333 pragma Inline (Initialization_Suppressed); 334 -- Returns True if initialization should be suppressed for the given type 335 -- or subtype. This is true if Suppress_Initialization is set either for 336 -- the subtype itself, or for the corresponding base type. 337 338 function Ultimate_Alias (Prim : Entity_Id) return Entity_Id; 339 pragma Inline (Ultimate_Alias); 340 -- Return the last entity in the chain of aliased entities of Prim. If Prim 341 -- has no alias return Prim. 342 343 function Unit_Declaration_Node (Unit_Id : Entity_Id) return Node_Id; 344 -- Unit_Id is the simple name of a program unit, this function returns the 345 -- corresponding xxx_Declaration node for the entity. Also applies to the 346 -- body entities for subprograms, tasks and protected units, in which case 347 -- it returns the subprogram, task or protected body node for it. The unit 348 -- may be a child unit with any number of ancestors. 349 350end Sem_Aux; 351