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
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N F O . U T I L S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2020-2024, 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. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Sinfo.Nodes; use Sinfo.Nodes;
package Sinfo.Utils is
-- We would like to get rid of the Library_Unit field, and replace it with
-- Other_Comp_Unit (on N_Compilation_Unit), Withed_Lib_Unit (on
-- N_With_Clause), and Subunit (on N_Body_Stub). Or we could split
-- Other_Comp_Unit into Spec_Lib_Unit, Body_Lib_Unit, Subunit_Parent.
-- However, gnat-llvm, codepeer, and spark are still using Library_Unit.
-- Therefore, we use the wrappers below.
--
-- The call site should always know whether it has an N_Compilation_Unit,
-- N_Body_Stub, or N_With_Clause. In the N_Compilation_Unit case, it should
-- also know whether it's looking for the spec of a body, the body of a
-- spec, or the parent of a subunit. Spec_Or_Body_Lib_Unit and
-- Other_Comp_Unit should be avoided when possible; these are for the
-- N_Compilation_Unit cases where the call site does NOT know what it's
-- looking for.
function Spec_Lib_Unit
(N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id;
procedure Set_Spec_Lib_Unit (N, Val : N_Compilation_Unit_Id);
-- The spec compilation unit of a body compilation unit.
-- It can be an acts-as-spec subprogram body; in that case
-- Spec_Lib_Unit points to itself.
function Body_Lib_Unit
(N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id;
procedure Set_Body_Lib_Unit (N, Val : N_Compilation_Unit_Id);
-- The body compilation unit of a spec compilation unit.
-- Empty if not present.
function Spec_Or_Body_Lib_Unit
(N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id;
-- Same as Spec_Lib_Unit or Body_Lib_Unit, depending on whether
-- N is a body or spec. Used when we know N is a library unit
-- (not a subunit), but we don't know whether it's the spec
-- or the body.
function Subunit_Parent
(N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id;
procedure Set_Subunit_Parent (N, Val : N_Compilation_Unit_Id);
-- The parent body of a subunit
function Other_Comp_Unit
(N : N_Compilation_Unit_Id) return Opt_N_Compilation_Unit_Id;
-- Same as Spec_Lib_Unit, Body_Lib_Unit, or Subunit_Parent,
-- as appropriate. Used when we don't know whether N is a
-- a library unit spec, library unit body, or subunit.
function Stub_Subunit (N : N_Body_Stub_Id) return Opt_N_Compilation_Unit_Id;
procedure Set_Stub_Subunit
(N : N_Body_Stub_Id; Val : N_Compilation_Unit_Id);
-- Subunit corresponding to a stub
function Withed_Lib_Unit
(N : N_With_Clause_Id) return Opt_N_Compilation_Unit_Id;
procedure Set_Withed_Lib_Unit
(N : N_With_Clause_Id; Val : N_Compilation_Unit_Id);
-- The compilation unit that a with clause refers to.
-- Note that the Sem_Elab creates with clauses that point to bodies
-- (including non-Acts_As_Spec bodies).
-------------------------------
-- Parent-related operations --
-------------------------------
procedure Copy_Parent (To, From : Node_Or_Entity_Id);
-- Does Set_Parent (To, Parent (From)), except that if To or From are
-- empty, does nothing. If From is empty but To is not, then Parent (To)
-- should already be Empty.
function Parent_Kind (N : Node_Id) return Node_Kind;
-- Same as Nkind (Parent (N)), except if N is Empty, return N_Empty
-------------------------
-- Iterator Procedures --
-------------------------
-- The call to Next_xxx (N) is equivalent to N := Next_xxx (N)
procedure Next_Entity (N : in out Node_Id);
procedure Next_Named_Actual (N : in out Node_Id);
procedure Next_Rep_Item (N : in out Node_Id);
procedure Next_Use_Clause (N : in out Node_Id);
-------------------------------------------
-- Miscellaneous Tree Access Subprograms --
-------------------------------------------
function First_Real_Statement -- ???
(Ignored : N_Handled_Sequence_Of_Statements_Id) return Node_Id is (Empty);
-- The First_Real_Statement field has been removed, but it is referenced in
-- codepeer and gnat-llvm. This is a temporary version, always returning
-- Empty, to ease the transition.
function End_Location (N : Node_Id) return Source_Ptr;
-- N is an N_If_Statement or N_Case_Statement node, and this function
-- returns the location of the IF token in the END IF sequence by
-- translating the value of the End_Span field.
-- WARNING: There is a matching C declaration of this subprogram in fe.h
procedure Set_End_Location (N : Node_Id; S : Source_Ptr);
-- N is an N_If_Statement or N_Case_Statement node. This procedure sets
-- the End_Span field to correspond to the given value S. In other words,
-- End_Span is set to the difference between S and Sloc (N), the starting
-- location.
function Get_Pragma_Arg (Arg : Node_Id) return Node_Id;
-- Given an argument to a pragma Arg, this function returns the expression
-- for the argument. This is Arg itself, or, in the case where Arg is a
-- pragma argument association node, the expression from this node.
-----------------------
-- Utility Functions --
-----------------------
procedure Map_Pragma_Name (From, To : Name_Id);
-- Used in the implementation of pragma Rename_Pragma. Maps pragma name
-- From to pragma name To, so From can be used as a synonym for To.
Too_Many_Pragma_Mappings : exception;
-- Raised if Map_Pragma_Name is called too many times. We expect that few
-- programs will use it at all, and those that do will use it approximately
-- once or twice.
function Pragma_Name (N : Node_Id) return Name_Id;
-- Obtain the name of pragma N from the Chars field of its identifier. If
-- the pragma has been renamed using Rename_Pragma, this routine returns
-- the name of the renaming.
function Pragma_Name_Unmapped (N : Node_Id) return Name_Id;
-- Obtain the name of pragma N from the Chars field of its identifier. This
-- form of name extraction does not take into account renamings performed
-- by Rename_Pragma.
generic
with procedure Action (U : Union_Id);
procedure Walk_Sinfo_Fields (N : Node_Id);
-- Walk the Sinfo fields of N, for all field types that Union_Id includes,
-- and call Action on each one. However, skip the Link field, which is the
-- Parent, and would cause us to wander off into the weeds.
generic
with function Transform (U : Union_Id) return Union_Id;
procedure Walk_Sinfo_Fields_Pairwise (N1, N2 : Node_Id);
-- Walks the Sinfo fields of N1 and N2 pairwise, calls Tranform on each N2
-- field, copying the resut into the corresponding field of N1. The Nkinds
-- must match. Link is skipped.
-------------------------------------------
-- Aliases for Entity_Or_Associated_Node --
-------------------------------------------
-- Historically, the Entity, Associated_Node, and Entity_Or_Associated_Node
-- fields shared the same slot. A further complication is that there is an
-- N_Has_Entity that does not include all node types that have the Entity
-- field. N_Inclusive_Has_Entity are the node types that have the Entity
-- field.
subtype N_Inclusive_Has_Entity is Node_Id with Predicate =>
N_Inclusive_Has_Entity in
N_Has_Entity_Id
| N_Attribute_Definition_Clause_Id
| N_Aspect_Specification_Id
| N_Freeze_Entity_Id
| N_Freeze_Generic_Entity_Id;
subtype N_Has_Associated_Node is Node_Id with Predicate =>
N_Has_Associated_Node in
N_Has_Entity_Id
| N_Aggregate_Id
| N_Extension_Aggregate_Id
| N_Selected_Component_Id
| N_Use_Package_Clause_Id;
function Associated_Node
(N : N_Has_Associated_Node) return Node_Id
renames Entity_Or_Associated_Node;
function Entity
(N : N_Inclusive_Has_Entity) return Node_Id
renames Entity_Or_Associated_Node;
procedure Set_Associated_Node
(N : N_Has_Associated_Node; Val : Node_Id)
renames Set_Entity_Or_Associated_Node;
procedure Set_Entity
(N : N_Inclusive_Has_Entity; Val : Node_Id)
renames Set_Entity_Or_Associated_Node;
---------------------------------------------------
-- Aliases for Aggregate_Bounds_Or_Ancestor_Type --
---------------------------------------------------
function Aggregate_Bounds (N : Node_Id) return Node_Id
renames Aggregate_Bounds_Or_Ancestor_Type;
function Ancestor_Type (N : Node_Id) return Node_Id
renames Aggregate_Bounds_Or_Ancestor_Type;
procedure Set_Aggregate_Bounds (N : Node_Id; Val : Node_Id)
renames Set_Aggregate_Bounds_Or_Ancestor_Type;
procedure Set_Ancestor_Type (N : Node_Id; Val : Node_Id)
renames Set_Aggregate_Bounds_Or_Ancestor_Type;
---------------
-- Debugging --
---------------
procedure New_Node_Debugging_Output (N : Node_Id);
pragma Inline (New_Node_Debugging_Output);
-- See package body for documentation
end Sinfo.Utils;
|
