1
------------------------------------------------------------------------------
3
-- ASIS-for-GNAT COMPONENTS --
5
-- A S I S . E X T E N S I O N S --
11
-- Copyright (c) 1995-2001, Free Software Foundation, Inc. --
13
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
14
-- under terms of the GNU General Public License as published by the Free --
15
-- Software Foundation; either version 2, or (at your option) any later --
16
-- version. ASIS-for-GNAT is distributed in the hope that it will be use- --
17
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
18
-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
19
-- Public License for more details. You should have received a copy of the --
20
-- GNU General Public License distributed with ASIS-for-GNAT; see file --
21
-- COPYING. If not, write to the Free Software Foundation, 59 Temple Place --
22
-- Suite 330, Boston, MA 02111-1307, USA. --
24
-- As a special exception, if other files instantiate generics from this --
25
-- unit, or you link this unit with other files to produce an executable, --
26
-- this unit does not by itself cause the resulting executable to be --
27
-- covered by the GNU General Public License. This exception does not --
28
-- however invalidate any other reasons why the executable file might be --
29
-- covered by the GNU Public License. --
31
-- ASIS-for-GNAT was originally developed by the ASIS-for-GNAT team at the --
32
-- Software Engineering Laboratory of the Swiss Federal Institute of --
33
-- Technology (LGL-EPFL) in Lausanne, Switzerland, in cooperation with the --
34
-- Scientific Research Computer Center of Moscow State University (SRCC --
35
-- MSU), Russia, with funding partially provided by grants from the Swiss --
36
-- National Science Foundation and the Swiss Academy of Engineering --
37
-- Sciences. ASIS-for-GNAT is now maintained by Ada Core Technologies Inc --
38
-- (http://www.gnat.com). --
40
------------------------------------------------------------------------------
42
-- This package contains some ASIS extensions which are needed by the ASIS
43
-- implementation for GNAT itself, or which are considered to be useful for
46
-- Most of these extensions may be implemented as secondary ASIS queries,
47
-- but we oftenly use some optimization based on direct traversing of the
48
-- GNAT tree and obtaining the needed semantic information from it.
50
-- In this package we follow the GNAT, but not ASIS coding and documentation
51
-- style, but for some queries we use the ASIS-style lists of Appropriate,
52
-- Expected and returned kinds.
54
with Ada.Unchecked_Deallocation;
56
with Asis.Text; use Asis.Text;
58
package Asis.Extensions is
60
-----------------------
61
-- List Access Types --
62
-----------------------
64
type Element_List_Access is access Element_List;
65
type Compilation_Unit_List_Access is access Compilation_Unit_List;
67
procedure Free is new Ada.Unchecked_Deallocation
68
(Element_List, Element_List_Access);
70
procedure Free is new Ada.Unchecked_Deallocation
71
(Compilation_Unit_List, Compilation_Unit_List_Access);
73
------------------------------------------------------
74
-- Placeholders for Traverse_Element instantiations --
75
------------------------------------------------------
77
-- If you do not need the state of traversing, and if you do not need
78
-- actual for Post-Operation in this case (this is the common case for
79
-- many situations when some simple traversing is required), the following
80
-- declarations may be used:
82
type No_State is (Not_Used);
83
-- Placeholder for the State_Information formal type
86
(Element : Asis.Element;
87
Control : in out Traverse_Control;
88
State : in out No_State);
89
-- Placeholder for the formal Post_Operation procedure
95
function Acts_As_Spec (Declaration : Asis.Element) return Boolean;
96
-- Checks if its argument is a subprogram body declaration for which no
97
-- separate subprogram declaration exists. Returns False for any
98
-- unexpected argument
100
-- Expected Element_Kinds:
101
-- A_Procedure_Body_Declaration
102
-- A_Function_Body_Declaration
103
-- A_Procedure_Body_Stub
104
-- A_Function_Body_Stub
106
function Is_Renaming_As_Body (Declaration : Asis.Element) return Boolean;
107
-- Checks if its argument is a renaming-as-body declaration.
108
-- Returns False for any unexpected argument.
110
-- Expected Element_Kinds:
111
-- A_Procedure_Renaning_Declaration
112
-- A_Function_Renaming_Declaration
114
function Is_Completed (Declaration : Asis.Element) return Boolean;
115
-- Checks is its argument (which is expected to be a declaration requiring
116
-- completion) has a completion in its enclosed ASIS Context.
118
-- Expected Element_Kinds (this list is not complete ???)
119
-- A_Procedure_Declaration
120
-- A_Function_Declaration
122
function Is_True_Expression
123
(Expression : Asis.Expression)
125
-- Checks if Expression is an expression in Ada sense, that is if it
126
-- is an expression as defined in RM 4.4, and the type of this expression
127
-- can be represented in ASIS. For cases of An_Expression Element for
128
-- which Is_True_Expression is True, the Corresponding_Expression_Type
129
-- query should yield non-Nil result
131
-- Expected Element_Kinds:
134
function Is_Static (Element : Asis.Element) return Boolean;
135
-- Checks if Element represent a static expression or a static range
136
-- constraint. "Static" is considered in the GNAT sense, that is if the
137
-- compiler computes it during the compilation time. We believe,
138
-- that GNAT notions of a static expression and a static range are close
139
-- to the corresponding definitions in RM 95, but we can not guarantee
140
-- this. Returns False for any unexpected Element
142
-- Expected Element_Kinds:
143
-- An_Expression for which Is_True_Expression yields True.
145
-- Expected Constraint_Kinds:
146
-- A_Range_Attribute_Reference
148
function Has_Enumeration_Type
149
(Expression : Asis.Expression)
151
-- Checks if Expression has some enumeration type (including types derived
152
-- from enumeration types). Returns False for any unexpected Element
154
-- Expected Element_Kinds:
155
-- An_Expression for which Is_True_Expression yields True.
157
function Has_Integer_Type (Expression : Asis.Expression) return Boolean;
158
-- Checks if Expression has some integer type (including types derived
159
-- from integer types). Returns False for any unexpected Element
161
-- Expected Element_Kinds:
162
-- An_Expression for which Is_True_Expression yields True.
164
function Is_Uniquely_Defined
165
(Reference : Asis.Expression)
167
-- Check if Reference has a unique definition. The Reference is expected
168
-- to be of An_Identifier, A_Character_Literal, An_Enumeration_Literal or
169
-- An_Operator_Symbol kind, that is, of the same kind as the argument of
170
-- Asis.Expressions.Corresponding_Name_Definition). This test may be used
171
-- to prevent calls of Asis.Expressions.Corresponding_Name_Definition and
172
-- Asis.Expressions.Corresponding_Name_Declaration which raise
173
-- ASIS_Inappropriate_Element (see the documentation of these queries).
174
-- Returns False for any unexpected argument.
176
-- Expected Element_Kinds:
178
-- An_Operator_Symbol
180
-----------------------------------------------------
181
-- Modified versions of the "primary" ASIS queries --
182
-----------------------------------------------------
184
-- This section contains the modified versions of the queries defined
185
-- in the standard ASIS packages. The names of these modified versions
186
-- may or may not be the same as in the "core" ASIS
194
type State_Information is limited private;
196
with procedure Pre_Operation
197
(Element : in Asis.Element;
198
Control : in out Traverse_Control;
199
State : in out State_Information) is <>;
201
with procedure Post_Operation
202
(Element : in Asis.Element;
203
Control : in out Traverse_Control;
204
State : in out State_Information) is <>;
206
procedure Traverse_Unit
207
(Unit : in Asis.Compilation_Unit;
208
Control : in out Traverse_Control;
209
State : in out State_Information);
210
-- This is slightly generalized version of Asis.Iterator.Traverse_Element.
211
-- Traverse_Unit instantiates traverse_Element passing its formal
212
-- parameters as actuals. It goes into all the first-depth-level structural
213
-- components of the argument unit and applies the instance of
214
-- Traverse_Element to it.
216
-- If the value of traverse Control becomes Terminate_Immediately,
217
-- traversing of all the unit components is terminated (that is, if it
218
-- happens in some context clause Element, the Unit declaration Element
219
-- will not be traversed.
221
-- Appropriate Unit_Kinds:
226
-- A_Generic_Procedure
227
-- A_Generic_Function
230
-- A_Procedure_Instance
231
-- A_Function_Instance
232
-- A_Package_Instance
234
-- A_Procedure_Renaming
235
-- A_Function_Renaming
236
-- A_Package_Renaming
238
-- A_Generic_Procedure_Renaming
239
-- A_Generic_Function_Renaming
240
-- A_Generic_Package_Renaming
247
-- A_Procedure_Body_Subunit
248
-- A_Function_Body_Subunit
249
-- A_Package_Body_Subunit
250
-- A_Task_Body_Subunit
251
-- A_Protected_Body_Subunit
253
-----------------------
254
-- Asis.Declarations --
255
-----------------------
257
function Formal_Subprogram_Default
258
(Declaration : Asis.Generic_Formal_Parameter)
259
return Asis.Expression;
260
-- This is a modified version of the query Formal_Subprogram_Default
261
-- adjusted for use in the implementation of Asis.Elements.Traverse_Element
262
-- generic procedure. Similarly to that ASIS query, it returns the name
263
-- appearing after the reserved word IS in the given generic for
264
-- A_Name_Default Element, but if its argument is of another kind from
265
-- Default_Kinds, it returns Nil_Element instead of raising
266
-- ASIS_Inappropriate_Element.
268
-- Appropriate Declaration_Kinds:
269
-- A_Formal_Function_Declaration
270
-- A_Formal_Procedure_Declaration
272
-- Returns Element_Kinds:
275
function Primitive_Owner
276
(Declaration : Asis.Declaration)
277
return Asis.Type_Definition;
278
-- In the case that Declaration the explicit declaration of a subprogram
279
-- which Is_Dispatching_Operation for some tagged type, this function
280
-- returns this tagged type definition. for which it is a primary
281
-- operation. (Note, that a subprogram declaration may be a primitive
282
-- operation for more then one type, but it may be a primitive
283
-- operation for at most one tagged type. Note also, that for implicitly
284
-- declared dispatching operations the primary ASIS query
285
-- Asis.Declarations.Corresponding_Type may be used to find the type which
286
-- "owns" the operation). Returns Nil_Element in all other cases.
288
-- Appropriate Declaration_Kinds:
289
-- A_Procedure_Declaration
290
-- A_Function_Declaration
291
-- A_Procedure_Renaming_Declaration
292
-- A_Function_Renaming_Declaration
294
-- Returns Definition_Kinds:
295
-- A_Tagged_Private_Type_Definition
296
-- A_Private_Extension_Definition
298
-- Returns Type_Kinds:
299
-- A_Derived_Record_Extension_Definition
300
-- A_Tagged_Record_Type_Definition
302
-- Returns Element_Kinds
305
----------------------
306
-- Asis.Expressions --
307
----------------------
309
function Corresponding_Called_Function_Unwinded
310
(Expression : Asis.Expression)
311
return Asis.Declaration;
312
-- A modification of Asis.Expressions.Corresponding_Called_Function which
313
-- unwinds all the renamings in the case where the function name in the
314
-- argument function call is defined by a renaming declaration. This
315
-- function returns the declaration of the called function *entity*.
317
-- Appropriate Expression_Kinds:
320
-- Returns Declaration_Kinds:
322
-- A_Function_Declaration
323
-- A_Function_Body_Declaration
324
-- A_Function_Body_Stub
325
-- A_Function_Renaming_Declaration
326
-- A_Function_Instantiation
327
-- A_Formal_Function_Declaration
329
---------------------
330
-- Asis.Statements --
331
---------------------
333
function Corresponding_Called_Entity_Unwinded
334
(Statement : Asis.Statement)
335
return Asis.Declaration;
337
-- A modification of Asis.Statements.Corresponding_Called_Entity which
338
-- unwinds all the renamings in the case where the procedure or entry name
339
-- in the argument call is defined by a renaming declaration. This function
340
-- returns the declaration of the callable *entity*.
342
-- Appropriate Statement_Kinds:
343
-- An_Entry_Call_Statement
344
-- A_Procedure_Call_Statement
346
-- Returns Declaration_Kinds:
348
-- A_Procedure_Declaration
349
-- A_Procedure_Body_Declaration
350
-- A_Procedure_Body_Stub
351
-- A_Procedure_Renaming_Declaration
352
-- A_Procedure_Instantiation
353
-- A_Formal_Procedure_Declaration
354
-- An_Entry_Declaration
356
--------------------------------------
357
-- Extensions of ASIS functionality --
358
--------------------------------------
360
----------------------------
361
-- Asis.Compilation_Units --
362
----------------------------
364
function Is_Obsolete (Right : Asis.Compilation_Unit) return Boolean;
365
-- Checks if the argument unit, Right, is obsolete. A unit is not
366
-- obsolete, if the source for this unit is available and if it
367
-- is the same as the source used for creating the trees. All
368
-- unit kinds are expected, except nil, unknown and nonexistent
369
-- units. Always returns True for any non-expected unit. In case
370
-- of '-SA' Context, always returns False for any expected unit.
372
type Source_File_Statuses is (
373
-- Status of the source file corresponding to a given unit
376
-- Nil value, used for nil, non-existent, and unknown units
379
-- No source file available. This is always the case for the
380
-- predefined Standard package, nil, unknown and non-existent
384
-- The available source file is older then the source used
385
-- to create tree files
388
-- The available source file is newer then the source used
389
-- to create tree files
392
-- The available source file is the same as the source used
393
-- to create tree files
395
function Source_File_Status
396
(Right : Asis.Compilation_Unit)
397
return Source_File_Statuses;
398
-- Checks the status of the source file for the argument unit.
400
function Is_Main_Unit_In_Tree
401
(Right : Asis.Compilation_Unit)
403
-- Checks if the argument unit, Right, is a main unit from some compilation
404
-- which has created a tree within the set of tree files making up the
405
-- enclosing Context of this unit.
407
function Main_Unit_In_Current_Tree
408
(The_Context : Asis.Context)
409
return Asis.Compilation_Unit;
410
-- If the tree currently accessed by ASIS is from the set of trees making
411
-- up The_Context, then this function returns the corresponding main unit,
412
-- that is, the Compilation_Unit corresponding to the source file which
413
-- has been compiled to create this tree file. Otherwise (this also
414
-- inludes the case when the currently accessed tree is null tree),
415
-- returns the main unit for the first tree in the set of trees making up
416
-- The_Context (the meaning of the notion "the first tree" is
417
-- implementation-dependent), and if this set is empty, returns
418
-- Nil_Compilation_Unit.
420
-- This function does not check if the argument Context is open.
422
-- This function is practically useful for "-C1" Contexts
424
function Compilation_Dependencies
425
(Main_Unit : Asis.Compilation_Unit)
426
return Asis.Compilation_Unit_List;
427
-- Provides the full list of units upon which Main_Unit depends
428
-- in the GNAT compilation system. The kind of dependencies
429
-- reported by this query combine semantic dependencies as
430
-- defined by RM 95 and GNAT-specific dependencies. Main_Unit
431
-- should be recompiled if any of the units from the returned
432
-- list has been changed.
434
-- Main_Unit should be a main unit from some compilation which
435
-- has created a tree wile from the set of tree files making up
436
-- the enclosing Context of Main_Unit.
438
-- ASIS_Inappropriate_Compilation_Unit is raised if Main_Unit
439
-- does not satisfy this restriction.
441
-- Note, that this query is supposed to be used for ASIS Contexts
442
-- representing complete Ada partitions, otherwise it may return
443
-- formally correct, but meaningless results.
445
-- The interface of this query is still subject to design discussions???
446
-- In particular, some limitations may be imposed on appropriate unit
447
-- kinds, or a special parameter may be added to filter out some parts
450
-- Appropriate Unit_Kinds:
454
-- A_Generic_Procedure
455
-- A_Generic_Function
458
-- A_Procedure_Instance
459
-- A_Function_Instance
460
-- A_Package_Instance
462
-- A_Procedure_Renaming
463
-- A_Function_Renaming
464
-- A_Package_Renaming
466
-- A_Generic_Procedure_Renaming
467
-- A_Generic_Function_Renaming
468
-- A_Generic_Package_Renaming
474
-- A_Procedure_Body_Subunit
475
-- A_Function_Body_Subunit
476
-- A_Package_Body_Subunit
477
-- A_Task_Body_Subunit
478
-- A_Protected_Body_Subunit
480
-- Returns Unit_Kinds:
484
-- A_Generic_Procedure
485
-- A_Generic_Function
488
-- A_Procedure_Instance
489
-- A_Function_Instance
490
-- A_Package_Instance
492
-- A_Procedure_Renaming
493
-- A_Function_Renaming
494
-- A_Package_Renaming
496
-- A_Generic_Procedure_Renaming
497
-- A_Generic_Function_Renaming
498
-- A_Generic_Package_Renaming
504
-- A_Procedure_Body_Subunit
505
-- A_Function_Body_Subunit
506
-- A_Package_Body_Subunit
507
-- A_Task_Body_Subunit
508
-- A_Protected_Body_Subunit
510
function Original_Text_Name
511
(Compilation_Unit : in Asis.Compilation_Unit)
513
-- In case if the source of the Compilation_Unit contains a
514
-- Source_Reference pragma, returns the file name from this pragma,
515
-- otherwise returns the same result as Asis.Compilation_Units.Text_Name
517
-- All Unit_Kinds are appropriate.
519
------------------------------------
520
-- Extensions to Asis.Expressions --
521
------------------------------------
523
function Corresponding_First_Definition
524
(Defining_Name : Asis.Defining_Name)
525
return Asis.Defining_Name;
526
-- In case there is more then one defining occurrence of an argument
527
-- Defining_Name representing the same view of the same entity (such as a
528
-- defining unit name for a program unit for which separate spec and body
529
-- are present and a formal parameter name for a generic subprogram or
530
-- subprogram having a separate spec) this function returns the first
531
-- defining occurrence which actually introduces the corresponding entity.
532
-- If there are only one defining occurrence of the argument Name, or if
533
-- for some reason the first defining occurrence cannot be returned, the
534
-- argument name is returned.
536
-- Appropriate Element kinds:
539
-- Returns Element kinds:
542
function Corresponding_Body_Parameter_Definition
543
(Defining_Name : Asis.Defining_Name)
544
return Asis.Defining_Name;
545
-- When applying to a defining name which is a name of a formal parameter
546
-- of a subprogram, this function returns the defining name of this
547
-- parameter from a subprogram body. If there is no body for this
548
-- subprogram, Nil_Element is returned. If Defining_Name is not a
549
-- defining name of a formal subprogram parameter, Nil_Element is
552
-- Appropriate Element kinds:
553
-- A_Defining_Identifier
555
-- Returns Element kinds:
556
-- A_Defining_Identifier
559
function Static_Expression_Value_Image
560
(Expression : Asis.Expression)
562
-- PARTIALLY IMPLEMENTED!!!
563
-- Computes the value of Expression (which should be a static expression!)
564
-- and represents it as a (wide) string. For enumeration expressions, the
565
-- image of the Pos value of the defining enumeration or character literal
566
-- corresponding to the value of the expression is returned (see
567
-- Asis.Declarations.Position_Number_Image query).
569
-- For ASIS Expression Elements for which Is_True_Expression yields False
570
-- and empty string is returned
572
-- For non-static expressions, an empty string is returned.
574
-- Currently this function is implemented only for discrete types. For
575
-- other types an empty string is returned.
577
-- Appropriate Element_Kinds:
580
function Static_Range_Low_Bound_Value_Image
581
(Range_Element : Asis.Range_Constraint)
583
-- PARTIALLY IMPLEMENTED!!!
584
-- For A_Range_Attribute_Reference constraint defining by a static range,
585
-- this function computes the value of the corresponding low bound and
586
-- represents it as a (wide) string. For enumeration ranges, the
587
-- image of the Pos value of the defining enumeration or character literal
588
-- corresponding to the value of the low bound is returned (see
589
-- Asis.Extensions.Static_Expression_Value_Image and
590
-- Asis.Declarations.Position_Number_Image queries).
592
-- For non-static expressions ranges, an empty string is returned.
594
-- Currently this function is implemented only for discrete types. For
595
-- other types an empty string is returned.
597
-- Appropriate Constraint_Kinds:
598
-- A_Range_Attribute_Reference
600
function Static_Range_High_Bound_Value_Image
601
(Range_Element : Asis.Range_Constraint)
603
-- PARTIALLY IMPLEMENTED!!!
604
-- For A_Range_Attribute_Reference constraint defining by a static range,
605
-- this function computes the value of the corresponding high bound and
606
-- represents it as a (wide) string. For enumeration ranges, the
607
-- image of the Pos value of the defining enumeration or character literal
608
-- corresponding to the value of the high bound is returned (see
609
-- Asis.Extensions.Static_Expression_Value_Image and
610
-- Asis.Declarations.Position_Number_Image queries).
612
-- For non-static expressions ranges, an empty string is returned.
614
-- Currently this function is implemented only for discrete types. For
615
-- other types an empty string is returned.
617
-- Appropriate Constraint_Kinds:
618
-- A_Range_Attribute_Reference
620
-- Appropriate Discrete_Range_Kinds:
621
-- A_Discrete_Range_Attribute_Reference
623
-----------------------------
624
-- Extensions to Asis.Text --
625
-----------------------------
627
function Element_Span_In_Template
628
(Element : Asis.Element)
629
return Asis.Text.Span;
630
-- If Is_Part_Of_Instance is True for the argument Element, then this
631
-- function returns the span of the corresponding piece of code in the
632
-- generic template. Otherwise a Nil_Span is returned. Nil_Span is also
633
-- returned if Is_Part_Of_Implicit Element is True for Element.
635
function Element_Image_In_Template
636
(Element : Asis.Element)
638
-- If Is_Part_Of_Instancce is True for the argument Element, then this
639
-- function returns the image of the corresponding piece of code in the
640
-- generic template. Otherwise a null string is returned. A null string
641
-- is also returned if Is_Part_Of_Implicit_ELement is true for Element
643
function Original_Line_Number
644
(Element : Asis.Element;
645
Compiled_Line : Line_Number_Positive)
647
-- If the enclosing compilation unit of the argument Element contains a
648
-- Source_Reference pragma, this function converts the line number of
649
-- the file which actually was compiled ("physical" file) into the
650
-- corresponding line number in the original file. For the line containing
651
-- a Source_Reference pragma zero is returned.
653
-- Raises ASIS_Inappropriate_Line_Number if Compiled_Line is greater then
654
-- the maximum line number of the compiled file
656
--------------------------------
657
-- General_Purpose Extensions --
658
--------------------------------
660
function Get_Last_Component (E : Asis.Element) return Asis.Element;
661
-- Returns the right-most direct component of its argument. Returns
662
-- Nil_Element if its argument has no components. It is an error to
663
-- call this function for Nil_Element
665
function Components (E : Asis.Element) return Asis.Element_List;
666
-- Returns the list of all the first-level components of its argument.
667
-- Nil_Element is returned for a terminal component.
668
-- The implementation
669
-- of this function is not very effective - we do not use any dynamic
670
-- element lists, we simply compute the components twice - first time
671
-- to get to know the overall number of components, and second
672
-- time to fill in the result Element_List
added
removed
asis/asis-extensions.ads
