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
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439 | ------------------------------------------------------------------------------
-- --
-- ASIS-for-GNAT IMPLEMENTATION COMPONENTS --
-- --
-- A 4 G . A _ T Y P E S --
-- --
-- S p e c --
-- --
-- Copyright (C) 1995-2019, Free Software Foundation, Inc. --
-- --
-- ASIS-for-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 --
-- Software Foundation; either version 3, or (at your option) any later --
-- version. ASIS-for-GNAT is distributed in the hope that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- --
-- --
-- --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
-- Software Engineering Laboratory of the Swiss Federal Institute of --
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
-- Scientific Research Computer Center of Moscow State University (SRCC --
-- MSU), Russia, with funding partially provided by grants from the Swiss --
-- National Science Foundation and the Swiss Academy of Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore --
-- (http://www.adacore.com). --
-- --
------------------------------------------------------------------------------
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package A4G.A_Types is
pragma Elaborate_Body (A4G.A_Types);
-- This package is the ASIS implementation's analog of the GNAT Types
-- package (except the part related to the ASIS_OS_Time type).
-- It contains host independent type and constant definitions
-- which is supposed to be used in more than one unit in the ASIS
-- implementation.
------------------
-- ASIS_OS_Time --
------------------
-- To check, that a given abstraction is valid in the sense defined by the
-- ASIS standard (that is, that the enclosing Context of the given
-- abstraction has not been closed after creating this abstraction), ASIS
-- needs some kind of logical time (or logical time stamp). This logical
-- time is increased each time when any ASIS Context is opened. It is not
-- reset when ASIS is initialized, because it may lead to collisions in
-- validity checks
-- An ASIS abstraction is valid if its logical time stamp is equal or
-- greater than the time stamp of its enclosing Context.
type ASIS_OS_Time is private;
Nil_ASIS_OS_Time : constant ASIS_OS_Time;
Last_ASIS_OS_Time : constant ASIS_OS_Time;
procedure Increase_ASIS_OS_Time;
-- Increases the ASIS logical "clock"
function A_OS_Time return ASIS_OS_Time;
-- Gets the current value of the ASIS logical "clock"
function Later (L, R : ASIS_OS_Time) return Boolean;
-- Compares time stamps.
-----------------------------------------
-- Types for Context and Context Table --
-----------------------------------------
Inconsistent_Incremental_Context : exception;
-- raised when any inconsistency found for Incremental Tree processing
-- mode
Context_Low_Bound : constant := 0;
Context_High_Bound : constant := 1_000_000;
type Context_Id is range Context_Low_Bound .. Context_High_Bound;
-- Type used to identify entries in ASIS Context table
Non_Associated : constant Context_Id := Context_Low_Bound;
Nil_Context_Id : constant Context_Id := Context_Low_Bound;
First_Context_Id : constant Context_Id := Context_Low_Bound + 1;
---------------------------------------------
-- Types for Container and Container Table --
---------------------------------------------
Container_Low_Bound : constant := 0;
Container_High_Bound : constant := 100;
type Container_Id is range Container_Low_Bound .. Container_High_Bound;
-- Type used to identify entries in ASIS Container table
Nil_Container_Id : constant Container_Id := Container_Low_Bound;
First_Container_Id : constant Container_Id := Container_Low_Bound + 1;
-----------------------------------------------
-- Types for Compilation_Unit and Unit Table --
-----------------------------------------------
Unit_Low_Bound : constant := 0;
Unit_High_Bound : constant := 100_000;
type Unit_Id is range Unit_Low_Bound .. Unit_High_Bound;
-- Type used to identify entries in the ASIS Unit table
Nil_Unit : constant Unit_Id := Unit_Low_Bound;
No_Unit_Id : Unit_Id renames Nil_Unit;
First_Unit_Id : constant Unit_Id := Unit_Low_Bound + 1;
Standard_Id : constant Unit_Id := First_Unit_Id;
-- The entry in the Unit table corresponding to the package Standard
-- Standard goes first in any Unit table
type Unit_Id_List is array (Natural range <>) of Unit_Id;
Nil_Unit_Id_List : constant Unit_Id_List (1 .. 0) := (others => Nil_Unit);
--------------------------
-- Types for Tree Table --
--------------------------
Tree_Low_Bound : constant := 0;
Tree_High_Bound : constant := 100_000;
type Tree_Id is range Tree_Low_Bound .. Tree_High_Bound;
-- Type used to identify entries in ASIS Tree table
Nil_Tree : constant Tree_Id := Tree_Low_Bound;
No_Tree_Name : Tree_Id renames Nil_Tree; -- ???
First_Tree_Id : constant Tree_Id := Tree_Low_Bound + 1;
-----------------------------------------------
-- Types for Search Directories Paths Tables --
-----------------------------------------------
No_Dir : constant := 0;
First_Dir_Id : constant := 1;
Last_Dir_Id : constant := 1_000;
type Dir_Id is range No_Dir .. Last_Dir_Id;
type Search_Dir_Kinds is (
Source, -- for source search path
Object, -- for object search path
Tree, -- for tree search path
Rep); -- for search path for files with representation information
-- this type may be further expanded
--------------------------------------------
-- Types for Internal Element Structure --
--------------------------------------------
type Special_Cases is (
-- this enumeration type is needed to distinguish some special
-- cases in Element constructing and handling
Not_A_Special_Case,
A_Dummy_Block_Statement,
-- the result of an obsolescent function
-- Declarations.Body_Block_Statement
Predefined_Operation,
-- indicates the predefined operation for a user-defined type
-- (or component thereof???). Note, that such an operation is
-- defined not in the Standard package.
--
-- This value is not used now.
Explicit_From_Standard,
-- indicates the explicit Element obtained from the package
-- Standard. "Explicit" means here any construct which is
-- contained in the "source" text of Standard included in RM95
-- plus explicit constants substituting "implementation-defined"
-- italic strings in this "source"
Numeric_Error_Renaming,
-- Indicates the artificial ASIS Element created to represent the
-- obsolete renaming of Numeric_Error in the package Standard
-- (see B712-005)
Implicit_From_Standard,
-- indicates the implicit Element obtained from the package
-- Standard, that is, implicitly declared predefined operations
-- and their components, and root and universal numeric type
-- definitions and declarations
Stand_Char_Literal,
-- indicates the defining character literal declared in the
-- definition of the predefined type Standard.Character
-- or Standard.Wide_Character. An ASIS Element representing such
-- a literal has no corresponding node in the tree, and it is
-- based on the N_Defining_Identifier node for the corresponding
-- type
Expanded_Package_Instantiation,
-- indicates A_Package_Declaration element which represents the
-- package declaration which is the result of an instantiation
-- of a generic package
Expanded_Subprogram_Instantiation,
-- indicates A_Procedure_Declaration or A_Function_Declaration
-- element which represents the package declaration which is the
-- result of an instantiation of a generic package
Configuration_File_Pragma,
-- Indicates a configuration pragma belonging not to the source of some
-- Ada compilation unit, but to the configuration file (an components
-- thereof)
Rewritten_Named_Number,
-- Indicates An_Identifier Element representing a named number in the
-- situation when the corresponding tree structure is rewritten into
-- N_Integer/Real_Literal node and no original tree structure is
-- available (see BB10-002)
Is_From_Gen_Association,
-- See D722-012.
-- The problem here is that in case of a formal object, the front-end
-- creates the renaming declaration as a means to pass an actual
-- parameter, and the parameter itself (the corresponding tree node)
-- is used as a part of this renaming declaration. So we have a problem
-- with Enclosing_Element. The Parent pointer from this actual points
-- to the renaming declaration structure. In case if we are not in the
-- expanded code, we may compare levels of instantiation and it helps,
-- but in general case it is too complicated. So the solution is to
-- mark the corresponding node if it comes from the generic association
-- (and we can gen into this node only by means of a structural query!)
-- and to use this mark in the Enclosing_Element processing.
Is_From_Imp_Neq_Declaration,
-- Indicates if the given element is an implicit declaration of the
-- "/=" operation corresponding to the explicit redefinition of "=" or
-- a subcomponent thereof
-- Implicit_Inherited_Subprogram
-- indicates the declaration of an implicit inherited user-defined
-- subprogram or a component thereof.
-- may be continued...
Dummy_Base_Attribute_Designator,
Dummy_Class_Attribute_Designator,
Dummy_Base_Attribute_Prefix,
Dummy_Class_Attribute_Prefix,
-- These four values are used to mark components of the artificial
-- 'Base and 'Class attribute reference that ASIS has to simulate when
-- processing references to a formal type in the instantiation in case
-- when a formal type is an unconstrained type, and the actual type is a
-- 'Class attribute, or when an actual is a 'Base attribute and the
-- front-end creates too much of artificial data structures in the tree.
From_Limited_View,
-- The corresponding Element is (a part of) a package or type limited
-- view, see RM 05 10.1.1 (12.1/2 .. 12.5.2)
End_Label
-- (a part of) an end label after the trailing END of a declaration or
-- a statement
-- may be continued...
);
subtype Expanded_Spec is Special_Cases
range Expanded_Package_Instantiation .. Expanded_Subprogram_Instantiation;
subtype Predefined is Special_Cases
range Predefined_Operation .. Stand_Char_Literal;
subtype Is_From_Standard is Special_Cases
range Explicit_From_Standard .. Stand_Char_Literal;
subtype Dummy_Attribute_Designators is Special_Cases
range Dummy_Base_Attribute_Designator .. Dummy_Class_Attribute_Designator;
subtype Dummy_Attribute_Prefixes is Special_Cases
range Dummy_Base_Attribute_Prefix .. Dummy_Class_Attribute_Prefix;
type Normalization_Cases is (
-- This enumeration type represents the different possible states of
-- An_Association Elements in respect to normalization of associations
Is_Not_Normalized,
Is_Normalized,
-- normalized association created for an actual parameter which itself
-- is presented at the place of the call/instantiation
Is_Normalized_Defaulted,
-- normalized association created for an actual parameter which itself
-- is NOT presented at the place of the call/instantiation, so the
-- default value should be used
Is_Normalized_Defaulted_For_Box,
-- normalized association created for an actual parameter which itself
-- is NOT presented at the place of the instantiation and the definition
-- of the formal parameter includes box as the default value, so the
-- actual parameter should be found at the place of the instantiation
Is_Normalized_Defaulted_Null_Procedure);
-- normalized association created for a formal subprogram that has a
-- null default in case when no actual procedure is provided at place of
-- instantiation. In this case an artificial Element is used as an
-- actual parameter.
subtype Normalized_Association is Normalization_Cases
range Is_Normalized .. Is_Normalized_Defaulted_Null_Procedure;
subtype Defaulted_Association is Normalization_Cases
range Is_Normalized_Defaulted .. Is_Normalized_Defaulted_Null_Procedure;
-- COMMENTS
--
-- *1* Handling the Parenthesized Expressions and
-- One_Pair_Of_Parentheses_Away and Two_Pairs_Of_Parentheses_Away
-- Special Cases.
--
-- An Asis Element of A_Parenthesized_Expression could be built
-- on the base of any tree node which could be used for building the
-- elements of all other An_Expresion subordinate kinds.
-- A_Parenthesized_Expression kind is determined by comparing (during
-- the automatic Internal_Element_Kinds determination only!!!) the
-- Paren_Count field of the node with zero - see Sinfo.ads, the
-- documentation item for "4.4 (Primary)" RM subsection, and
-- Atree.ads the documentation item related to the Paren_Count field.
--
-- When a subexpression is to be selected from the element of
-- A_Parenthesized_Expression kind by the
-- Asis_Definition.Expression_Parenthesized function, the result will
-- be built on the base of just the same node as the argument having,
-- just the same value of the Paren_Count field. If the argument has
-- more than one pair of parentheses, the result will also be of
-- A_Parenthesized_Expression kind, and the Special_Cases values
-- One_Pair_Of_Parentheses_Away and Two_Pairs_Of_Parentheses_Away
-- are intended to be used to count the pairs of parentheses remained
-- in the result element. All the corresponding element kind
-- determination and element construction should be performed in
-- "by-hand" mode, except the case when the argument parenthesized
-- expression has only one pair of parentheses.
--
-- GNAT cannot distinguish more than three levels of the enclosing
-- pairs of parentheses for a non-parenthesized enclosed expression.
-- (Paren_Count = 3 stands for any number of the enclosing parentheses
-- equal or greater than 3.) So ASIS-for-GNAT implementation cannot
-- do more than GNAT itself (of course, we could do some search in the
-- source buffer, but we prefer to agree with GNAT team that even
-- Paren_Count = 3 already is a pathological case :).
--
-- See also Asis_Definition.Expression_Parenthesized (body) and
-- A4G.Mapping.Node_To_Element (body)
--
-- *2* Root/Universal types definitions - we do not need any special
-- value for representing elements of Root_Type_Kinds, because for
-- each value there may be only one Element of the corresponding kind
-- in a given opened Context.
--
-------------------------
-- Nil String constants--
-------------------------
Nil_Asis_String : constant String := "";
Nil_Asis_Wide_String : constant Wide_String := "";
-------------------------------------------------
-- Constants for the Diagnosis string buffer --
-------------------------------------------------
ASIS_Line_Terminator : constant String := (1 => LF);
-- what about DOS-like end-of-line?
Diagnosis_String_Length : constant Positive :=
76 + ASIS_Line_Terminator'Length;
-- We are trying to set ASIS_Line_Terminator in the Diagnosis string to
-- keep text strings at most 76 characters long
Max_Diagnosis_Length : constant Positive := 32 * Diagnosis_String_Length;
-- The length of the buffer in which the Diagnosis string is formed,
-- now it is at most 32 lines 76 character each. Should be enough for
-- any practically meaningful diagnosis
Asis_Wide_Line_Terminator : constant Wide_String :=
(1 => To_Wide_Character (LF));
--
-- the physical line terminator, is used in the Diagnosis string
-- to separate the parts of the diagnosis message
-- See also documentation of the Skip_Line_Terminators procedure
-- in the (GNAT.)sinput.adb
ASIS_Line_Terminator_Len : constant Positive
:= ASIS_Line_Terminator'Length;
Incorrect_Setting : constant String := "Attempt to set Not_An_Error "
& "status with non-nil diagnosis string";
Incorrect_Setting_Len : constant Positive := Incorrect_Setting'Length;
-------------------
-- Miscellaneous --
-------------------
Internal_Implementation_Error : exception;
-- Means exactly this. Is supposed to be raised in control statement
-- paths which should never be reached. We need this exception mostly
-- because some parts of old ASIS code (developed at the research stage of
-- the ASIS project) sometimes are not structured properly.
function Parameter_String_To_List
(Par_String : String)
return Argument_List_Access;
-- Take a string that is a converted to the String type Parameters string
-- of the ASIS query Initialize, Associate or Finalize (??? Should we
-- process the original Wide_String Parameters string without converting
-- it to String?) and parse it into an Argument_List.
--
-- This function is similar to GNAT.OS_Int.Argument_String_To_List, but
-- it does not treat '\' as a backquoting character.
private
type ASIS_OS_Time is new Long_Integer range 0 .. Long_Integer'Last;
ASIS_Clock : ASIS_OS_Time := 1;
-- This is the ASIS logical "clock" used to ret ASIS logical time.
Nil_ASIS_OS_Time : constant ASIS_OS_Time := 0;
Last_ASIS_OS_Time : constant ASIS_OS_Time := ASIS_OS_Time'Last;
end A4G.A_Types;
|