1------------------------------------------------------------------------------ 2-- -- 3-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS -- 4-- -- 5-- A 4 G . A _ T Y P E S -- 6-- -- 7-- S p e c -- 8-- -- 9-- Copyright (C) 1995-2015, Free Software Foundation, Inc. -- 10-- -- 11-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 3, or (at your option) any later -- 14-- version. ASIS-for-GNAT is distributed in the hope that it will be use- -- 15-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- 16-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- -- 19-- -- 20-- -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the -- 28-- Software Engineering Laboratory of the Swiss Federal Institute of -- 29-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the -- 30-- Scientific Research Computer Center of Moscow State University (SRCC -- 31-- MSU), Russia, with funding partially provided by grants from the Swiss -- 32-- National Science Foundation and the Swiss Academy of Engineering -- 33-- Sciences. ASIS-for-GNAT is now maintained by AdaCore -- 34-- (http://www.adacore.com). -- 35-- -- 36------------------------------------------------------------------------------ 37with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; 38with Ada.Characters.Handling; use Ada.Characters.Handling; 39 40with GNAT.OS_Lib; use GNAT.OS_Lib; 41 42package A4G.A_Types is 43 44 pragma Elaborate_Body (A4G.A_Types); 45 46-- This package is the ASIS implementation's analog of the GNAT Types 47-- package (except the part related to the ASIS_OS_Time type). 48-- It contains host independent type and constant definitions 49-- which is supposed to be used in more than one unit in the ASIS 50-- implementation. 51 52 ------------------ 53 -- ASIS_OS_Time -- 54 ------------------ 55 56 -- To check, that a given abstraction is valid in the sense defined by the 57 -- ASIS standard (that is, that the enclosing Context of the given 58 -- abstraction has not been closed after creating this abstraction), ASIS 59 -- needs some kind of logical time (or logical time stamp). This logical 60 -- time is increased each time when any ASIS Context is opened. It is not 61 -- reset when ASIS is initialized, because it may lead to collisions in 62 -- validity checks 63 64 -- An ASIS abstraction is valid if its logical time stamp is equal or 65 -- greater than the time stamp of its enclosing Context. 66 67 type ASIS_OS_Time is private; 68 69 Nil_ASIS_OS_Time : constant ASIS_OS_Time; 70 Last_ASIS_OS_Time : constant ASIS_OS_Time; 71 72 procedure Increase_ASIS_OS_Time; 73 -- Increases the ASIS logical "clock" 74 75 function A_OS_Time return ASIS_OS_Time; 76 -- Gets the current value of the ASIS logical "clock" 77 78 function Later (L, R : ASIS_OS_Time) return Boolean; 79 -- Compares time stamps. 80 81 ----------------------------------------- 82 -- Types for Context and Context Table -- 83 ----------------------------------------- 84 85 Inconsistent_Incremental_Context : exception; 86 -- raised when any inconsistency found for Incremental Tree processing 87 -- mode 88 89 Context_Low_Bound : constant := 0; 90 Context_High_Bound : constant := 1_000_000; 91 92 type Context_Id is range Context_Low_Bound .. Context_High_Bound; 93 -- Type used to identify entries in ASIS Context table 94 95 Non_Associated : constant Context_Id := Context_Low_Bound; 96 Nil_Context_Id : constant Context_Id := Context_Low_Bound; 97 First_Context_Id : constant Context_Id := Context_Low_Bound + 1; 98 99 --------------------------------------------- 100 -- Types for Container and Container Table -- 101 --------------------------------------------- 102 103 Container_Low_Bound : constant := 0; 104 Container_High_Bound : constant := 100; 105 106 type Container_Id is range Container_Low_Bound .. Container_High_Bound; 107 -- Type used to identify entries in ASIS Container table 108 109 Nil_Container_Id : constant Container_Id := Container_Low_Bound; 110 First_Container_Id : constant Container_Id := Container_Low_Bound + 1; 111 112 ----------------------------------------------- 113 -- Types for Compilation_Unit and Unit Table -- 114 ----------------------------------------------- 115 116 Unit_Low_Bound : constant := 0; 117 Unit_High_Bound : constant := 100_000; 118 119 type Unit_Id is range Unit_Low_Bound .. Unit_High_Bound; 120 -- Type used to identify entries in the ASIS Unit table 121 122 Nil_Unit : constant Unit_Id := Unit_Low_Bound; 123 No_Unit_Id : Unit_Id renames Nil_Unit; 124 125 First_Unit_Id : constant Unit_Id := Unit_Low_Bound + 1; 126 Standard_Id : constant Unit_Id := First_Unit_Id; 127 -- The entry in the Unit table corresponding to the package Standard 128 -- Standard goes first in any Unit table 129 130 type Unit_Id_List is array (Natural range <>) of Unit_Id; 131 Nil_Unit_Id_List : constant Unit_Id_List (1 .. 0) := (others => Nil_Unit); 132 133 -------------------------- 134 -- Types for Tree Table -- 135 -------------------------- 136 137 Tree_Low_Bound : constant := 0; 138 Tree_High_Bound : constant := 100_000; 139 140 type Tree_Id is range Tree_Low_Bound .. Tree_High_Bound; 141 -- Type used to identify entries in ASIS Tree table 142 143 Nil_Tree : constant Tree_Id := Tree_Low_Bound; 144 No_Tree_Name : Tree_Id renames Nil_Tree; -- ??? 145 First_Tree_Id : constant Tree_Id := Tree_Low_Bound + 1; 146 147 ----------------------------------------------- 148 -- Types for Search Directories Paths Tables -- 149 ----------------------------------------------- 150 151 No_Dir : constant := 0; 152 First_Dir_Id : constant := 1; 153 Last_Dir_Id : constant := 1_000; 154 155 type Dir_Id is range No_Dir .. Last_Dir_Id; 156 157 type Search_Dir_Kinds is ( 158 Source, -- for source search path 159 Object, -- for object search path 160 Tree); -- for tree search path 161 -- this type may be further expanded 162 163 -------------------------------------------- 164 -- Types for Internal Element Structure -- 165 -------------------------------------------- 166 167 type Special_Cases is ( 168 -- this enumeration type is needed to distinguish some special 169 -- cases in Element constructing and handling 170 Not_A_Special_Case, 171 172 A_Dummy_Block_Statement, 173 -- the result of an obsolescent function 174 -- Declarations.Body_Block_Statement 175 176 Predefined_Operation, 177 -- indicates the predefined operation for a user-defined type 178 -- (or component thereof???). Note, that such an operation is 179 -- defined not in the Standard package. 180 181 Explicit_From_Standard, 182 -- indicates the explicit Element obtained from the package 183 -- Standard. "Explicit" means here any construct which is 184 -- contained in the "source" text of Standard included in RM95 185 -- plus explicit constants substituting "implementation-defined" 186 -- italic strings in this "source" 187 188 Numeric_Error_Renaming, 189 -- Indicates the artificial ASIS Element created to represent the 190 -- obsolete renaming of Numeric_Error in the package Standard 191 -- (see B712-005) 192 193 Implicit_From_Standard, 194 -- indicates the implicit Element obtained from the package 195 -- Standard, that is, implicitly declared predefined operations 196 -- and their components, and root and universal numeric type 197 -- definitions and declarations 198 199 Stand_Char_Literal, 200 -- indicates the defining character literal declared in the 201 -- definition of the predefined type Standard.Character 202 -- or Standard.Wide_Character. An ASIS Element representing such 203 -- a literal has no corresponding node in the tree, and it is 204 -- based on the N_Defining_Identifier node for the corresponding 205 -- type 206 207 Expanded_Package_Instantiation, 208 -- indicates A_Package_Declaration element which represents the 209 -- package declaration which is the result of an instantiation 210 -- of a generic package 211 212 Expanded_Subprogram_Instantiation, 213 -- indicates A_Procedure_Declaration or A_Function_Declaration 214 -- element which represents the package declaration which is the 215 -- result of an instantiation of a generic package 216 217 Configuration_File_Pragma, 218 -- Indicates a configuration pragma belonging not to the source of some 219 -- Ada compilation unit, but to the configuration file (an components 220 -- thereof) 221 222 Rewritten_Named_Number, 223 -- Indicates An_Identifier Element representing a named number in the 224 -- situation when the corresponding tree structure is rewritten into 225 -- N_Integer/Real_Literal node and no original tree structure is 226 -- available (see BB10-002) 227 228 Is_From_Gen_Association, 229 -- See D722-012. 230 -- The problem here is that in case of a formal object, the front-end 231 -- creates the renaming declaration as a means to pass an actual 232 -- parameter, and the parameter itself (the corresponding tree node) 233 -- is used as a part of this renaming declaration. So we have a problem 234 -- with Enclosing_Element. The Parent pointer from this actual points 235 -- to the renaming declaration structure. In case if we are not in the 236 -- expanded code, we may compare levels of instantiation and it helps, 237 -- but in general case it is too complicated. So the solution is to 238 -- mark the corresponding node if it comes from the generic association 239 -- (and we can gen into this node only by means of a structural query!) 240 -- and to use this mark in the Enclosing_Element processing. 241 242 Is_From_Imp_Neq_Declaration, 243 -- Indicates if the given element is an implicit declaration of the 244 -- "/=" operation corresponding to the explicit redefinition of "=" or 245 -- a subcomponent thereof 246 247-- Implicit_Inherited_Subprogram 248 -- indicates the declaration of an implicit inherited user-defined 249 -- subprogram or a component thereof. 250 -- may be continued... 251 252 Dummy_Base_Attribute_Designator, 253 Dummy_Class_Attribute_Designator, 254 Dummy_Base_Attribute_Prefix, 255 Dummy_Class_Attribute_Prefix, 256 -- These four values are used to mark components of the artificial 257 -- 'Base and 'Class attribute reference that ASIS has to simulate when 258 -- processing references to a formal type in the instantiation in case 259 -- when a formal type is an unconstrained type, and the actual type is a 260 -- 'Class attribute, or when an actual is a 'Base attribute and the 261 -- front-end creates too much of artificial data structures in the tree. 262 263 From_Limited_View, 264 -- The corresponding Element is (a part of) a package or type limited 265 -- view, see RM 05 10.1.1 (12.1/2 .. 12.5.2) 266 267 End_Label 268 -- (a part of) an end label after the trailing END of a declaration or 269 -- a statement 270 271 -- may be continued... 272 273 ); 274 275 subtype Expanded_Spec is Special_Cases 276 range Expanded_Package_Instantiation .. Expanded_Subprogram_Instantiation; 277 278 subtype Predefined is Special_Cases 279 range Predefined_Operation .. Stand_Char_Literal; 280 281 subtype Is_From_Standard is Special_Cases 282 range Explicit_From_Standard .. Stand_Char_Literal; 283 284 subtype Dummy_Attribute_Designators is Special_Cases 285 range Dummy_Base_Attribute_Designator .. Dummy_Class_Attribute_Designator; 286 287 subtype Dummy_Attribute_Prefixes is Special_Cases 288 range Dummy_Base_Attribute_Prefix .. Dummy_Class_Attribute_Prefix; 289 290 type Normalization_Cases is ( 291 -- This enumeration type represents the different possible states of 292 -- An_Association Elements in respect to normalization of associations 293 Is_Not_Normalized, 294 Is_Normalized, 295 -- normalized association created for an actual parameter which itself 296 -- is presented at the place of the call/instantiation 297 Is_Normalized_Defaulted, 298 -- normalized association created for an actual parameter which itself 299 -- is NOT presented at the place of the call/instantiation, so the 300 -- default value should be used 301 Is_Normalized_Defaulted_For_Box, 302 -- normalized association created for an actual parameter which itself 303 -- is NOT presented at the place of the instantiation and the definition 304 -- of the formal parameter includes box as the default value, so the 305 -- actual parameter should be found at the place of the instantiation 306 Is_Normalized_Defaulted_Null_Procedure); 307 -- normalized association created for a formal subprogram that has a 308 -- null default in case when no actual procedure is provided at place of 309 -- instantiation. In this case an artificial Element is used as an 310 -- actual parameter. 311 312 subtype Normalized_Association is Normalization_Cases 313 range Is_Normalized .. Is_Normalized_Defaulted_Null_Procedure; 314 315 subtype Defaulted_Association is Normalization_Cases 316 range Is_Normalized_Defaulted .. Is_Normalized_Defaulted_Null_Procedure; 317 318 -- COMMENTS 319 -- 320 -- *1* Handling the Parenthesized Expressions and 321 -- One_Pair_Of_Parentheses_Away and Two_Pairs_Of_Parentheses_Away 322 -- Special Cases. 323 -- 324 -- An Asis Element of A_Parenthesized_Expression could be built 325 -- on the base of any tree node which could be used for building the 326 -- elements of all other An_Expresion subordinate kinds. 327 -- A_Parenthesized_Expression kind is determined by comparing (during 328 -- the automatic Internal_Element_Kinds determination only!!!) the 329 -- Paren_Count field of the node with zero - see Sinfo.ads, the 330 -- documentation item for "4.4 (Primary)" RM subsection, and 331 -- Atree.ads the documentation item related to the Paren_Count field. 332 -- 333 -- When a subexpression is to be selected from the element of 334 -- A_Parenthesized_Expression kind by the 335 -- Asis_Definition.Expression_Parenthesized function, the result will 336 -- be built on the base of just the same node as the argument having, 337 -- just the same value of the Paren_Count field. If the argument has 338 -- more than one pair of parentheses, the result will also be of 339 340 -- A_Parenthesized_Expression kind, and the Special_Cases values 341 -- One_Pair_Of_Parentheses_Away and Two_Pairs_Of_Parentheses_Away 342 -- are intended to be used to count the pairs of parentheses remained 343 -- in the result element. All the corresponding element kind 344 -- determination and element construction should be performed in 345 -- "by-hand" mode, except the case when the argument parenthesized 346 -- expression has only one pair of parentheses. 347 -- 348 -- GNAT cannot distinguish more than three levels of the enclosing 349 -- pairs of parentheses for a non-parenthesized enclosed expression. 350 -- (Paren_Count = 3 stands for any number of the enclosing parentheses 351 -- equal or greater than 3.) So ASIS-for-GNAT implementation cannot 352 -- do more than GNAT itself (of course, we could do some search in the 353 -- source buffer, but we prefer to agree with GNAT team that even 354 -- Paren_Count = 3 already is a pathological case :). 355 -- 356 -- See also Asis_Definition.Expression_Parenthesized (body) and 357 -- A4G.Mapping.Node_To_Element (body) 358 -- 359 -- *2* Root/Universal types definitions - we do not need any special 360 -- value for representing elements of Root_Type_Kinds, because for 361 -- each value there may be only one Element of the corresponding kind 362 -- in a given opened Context. 363 -- 364 365 ------------------------- 366 -- Nil String constants-- 367 ------------------------- 368 369 Nil_Asis_String : constant String := ""; 370 Nil_Asis_Wide_String : constant Wide_String := ""; 371 372 ------------------------------------------------- 373 -- Constants for the Diagnosis string buffer -- 374 ------------------------------------------------- 375 376 ASIS_Line_Terminator : constant String := (1 => LF); 377 -- what about DOS-like end-of-line? 378 379 Diagnosis_String_Length : constant Positive := 380 76 + ASIS_Line_Terminator'Length; 381 -- We are trying to set ASIS_Line_Terminator in the Diagnosis string to 382 -- keep text strings at most 76 characters long 383 384 Max_Diagnosis_Length : constant Positive := 32 * Diagnosis_String_Length; 385 -- The length of the buffer in which the Diagnosis string is formed, 386 -- now it is at most 32 lines 76 character each. Should be enough for 387 -- any practically meaningful diagnosis 388 389 Asis_Wide_Line_Terminator : constant Wide_String := 390 (1 => To_Wide_Character (LF)); 391 -- 392 -- the physical line terminator, is used in the Diagnosis string 393 -- to separate the parts of the diagnosis message 394 -- See also documentation of the Skip_Line_Terminators procedure 395 -- in the (GNAT.)sinput.adb 396 397 ASIS_Line_Terminator_Len : constant Positive 398 := ASIS_Line_Terminator'Length; 399 400 Incorrect_Setting : constant String := "Attempt to set Not_An_Error " 401 & "status with non-nil diagnosis string"; 402 403 Incorrect_Setting_Len : constant Positive := Incorrect_Setting'Length; 404 405 ------------------- 406 -- Miscellaneous -- 407 ------------------- 408 409 Internal_Implementation_Error : exception; 410 -- Means exactly this. Is supposed to be raised in control statement 411 -- paths which should never be reached. We need this exception mostly 412 -- because some parts of old ASIS code (developed at the research stage of 413 -- the ASIS project) sometimes are not structured properly. 414 415 function Parameter_String_To_List 416 (Par_String : String) 417 return Argument_List_Access; 418 -- Take a string that is a converted to the String type Parameters string 419 -- of the ASIS query Initialize, Associate or Finalize (??? Should we 420 -- process the original Wide_String Parameters string without converting 421 -- it to String?) and parse it into an Argument_List. 422 -- 423 -- This function is similar to GNAT.OS_Int.Argument_String_To_List, but 424 -- it does not treat '\' as a backquoting character. 425 426private 427 428 type ASIS_OS_Time is new Long_Integer range 0 .. Long_Integer'Last; 429 430 ASIS_Clock : ASIS_OS_Time := 1; 431 -- This is the ASIS logical "clock" used to ret ASIS logical time. 432 433 Nil_ASIS_OS_Time : constant ASIS_OS_Time := 0; 434 Last_ASIS_OS_Time : constant ASIS_OS_Time := ASIS_OS_Time'Last; 435 436end A4G.A_Types; 437