/usr/share/ada/adainclude/gnatvsn/sem_aux.ads is in libgnatvsn4.8-dev 4.8.2-8ubuntu3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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;
|