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
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- T B U I L D --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2010, 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. --
-- --
------------------------------------------------------------------------------
-- This package contains various utility procedures to assist in building
-- specific types of tree nodes.
with Namet; use Namet;
with Sinfo; use Sinfo;
with Types; use Types;
with Uintp; use Uintp;
package Tbuild is
function Checks_Off (N : Node_Id) return Node_Id;
pragma Inline (Checks_Off);
-- Returns an N_Unchecked_Expression node whose expression is the given
-- argument. The results is a subexpression identical to the argument,
-- except that it will be analyzed and resolved with checks off.
function Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
-- Returns an expression that represents the result of a checked convert
-- of expression Exp to type T. If the base type of Exp is T, then no
-- conversion is required, and Exp is returned unchanged. Otherwise an
-- N_Type_Conversion node is constructed to convert the expression.
-- If an N_Type_Conversion node is required, Relocate_Node is used on
-- Exp. This means that it is safe to replace a node by a Convert_To
-- of itself to some other type.
procedure Discard_Node (N : Node_Or_Entity_Id);
pragma Inline (Discard_Node);
-- This is a dummy procedure that simply returns and does nothing. It is
-- used when a function returning a Node_Id value is called for its side
-- effect (e.g. a call to Make to construct a node) but the Node_Id value
-- is not required.
procedure Discard_List (L : List_Id);
pragma Inline (Discard_List);
-- This is a dummy procedure that simply returns and does nothing. It is
-- used when a function returning a Node_Id value is called for its side
-- effect (e.g. a call to the parser to parse a list of compilation
-- units), but the List_Id value is not required.
function Make_Byte_Aligned_Attribute_Reference
(Sloc : Source_Ptr;
Prefix : Node_Id;
Attribute_Name : Name_Id) return Node_Id;
pragma Inline (Make_Byte_Aligned_Attribute_Reference);
-- Like the standard Make_Attribute_Reference but the special flag
-- Must_Be_Byte_Aligned is set in the attribute reference node. The
-- Attribute_Name must be Name_Address or Name_Unrestricted_Access.
function Make_DT_Access
(Loc : Source_Ptr; Rec : Node_Id; Typ : Entity_Id) return Node_Id;
-- Create an access to the Dispatch Table by using the Tag field of a
-- tagged record : Acc_Dt (Rec.tag).all
function Make_Float_Literal
(Loc : Source_Ptr;
Radix : Uint;
Significand : Uint;
Exponent : Uint) return Node_Id;
-- Create a real literal for the floating point expression value
-- Significand * Radix ** Exponent. Radix must be greater than 1.
function Make_Implicit_Exception_Handler
(Sloc : Source_Ptr;
Choice_Parameter : Node_Id := Empty;
Exception_Choices : List_Id;
Statements : List_Id) return Node_Id;
pragma Inline (Make_Implicit_Exception_Handler);
-- This is just like Make_Exception_Handler, except that it also sets the
-- Local_Raise_Statements field to No_Elist, ensuring that it is properly
-- initialized. This should always be used when creating implicit exception
-- handlers during expansion (i.e. handlers that do not correspond to user
-- source program exception handlers).
function Make_Implicit_If_Statement
(Node : Node_Id;
Condition : Node_Id;
Then_Statements : List_Id;
Elsif_Parts : List_Id := No_List;
Else_Statements : List_Id := No_List) return Node_Id;
pragma Inline (Make_Implicit_If_Statement);
-- This function makes an N_If_Statement node whose fields are filled
-- in with the indicated values (see Sinfo), and whose Sloc field is
-- is set to Sloc (Node). The effect is identical to calling function
-- Nmake.Make_If_Statement except that there is a check for restriction
-- No_Implicit_Conditionals, and if this restriction is being violated,
-- an error message is posted on Node.
function Make_Implicit_Label_Declaration
(Loc : Source_Ptr;
Defining_Identifier : Node_Id;
Label_Construct : Node_Id) return Node_Id;
-- Used to construct an implicit label declaration node, including setting
-- the proper Label_Construct field (since Label_Construct is a semantic
-- field, the normal call to Make_Implicit_Label_Declaration does not
-- set this field).
function Make_Implicit_Loop_Statement
(Node : Node_Id;
Statements : List_Id;
Identifier : Node_Id := Empty;
Iteration_Scheme : Node_Id := Empty;
Has_Created_Identifier : Boolean := False;
End_Label : Node_Id := Empty) return Node_Id;
-- This function makes an N_Loop_Statement node whose fields are filled
-- in with the indicated values (see Sinfo), and whose Sloc field is
-- is set to Sloc (Node). The effect is identical to calling function
-- Nmake.Make_Loop_Statement except that there is a check for restrictions
-- No_Implicit_Loops and No_Implicit_Conditionals (the first applying in
-- all cases, and the second only for while loops), and if one of these
-- restrictions is being violated, an error message is posted on Node.
function Make_Integer_Literal
(Loc : Source_Ptr;
Intval : Int) return Node_Id;
pragma Inline (Make_Integer_Literal);
-- A convenient form of Make_Integer_Literal taking Int instead of Uint
function Make_Linker_Section_Pragma
(Ent : Entity_Id;
Loc : Source_Ptr;
Sec : String) return Node_Id;
-- Construct a Linker_Section pragma for entity Ent, using string Sec as
-- the section name. Loc is the Sloc value to use in building the pragma.
function Make_Pragma
(Sloc : Source_Ptr;
Chars : Name_Id;
Pragma_Argument_Associations : List_Id := No_List;
Debug_Statement : Node_Id := Empty) return Node_Id;
-- A convenient form of Make_Pragma not requiring a Pragma_Identifier
-- argument (this argument is built from the value given for Chars).
function Make_Raise_Constraint_Error
(Sloc : Source_Ptr;
Condition : Node_Id := Empty;
Reason : RT_Exception_Code) return Node_Id;
pragma Inline (Make_Raise_Constraint_Error);
-- A convenient form of Make_Raise_Constraint_Error where the Reason
-- is given simply as an enumeration value, rather than a Uint code.
function Make_Raise_Program_Error
(Sloc : Source_Ptr;
Condition : Node_Id := Empty;
Reason : RT_Exception_Code) return Node_Id;
pragma Inline (Make_Raise_Program_Error);
-- A convenient form of Make_Raise_Program_Error where the Reason
-- is given simply as an enumeration value, rather than a Uint code.
function Make_Raise_Storage_Error
(Sloc : Source_Ptr;
Condition : Node_Id := Empty;
Reason : RT_Exception_Code) return Node_Id;
pragma Inline (Make_Raise_Storage_Error);
-- A convenient form of Make_Raise_Storage_Error where the Reason is given
-- simply as an enumeration value, rather than a Uint code.
function Make_String_Literal
(Sloc : Source_Ptr;
Strval : String) return Node_Id;
-- A convenient form of Make_String_Literal, where the string value is
-- given as a normal string instead of a String_Id value.
function Make_Temporary
(Loc : Source_Ptr;
Id : Character;
Related_Node : Node_Id := Empty) return Entity_Id;
-- This function should be used for all cases where a defining identifier
-- is to be built with a name to be obtained by New_Internal_Name (here Id
-- is the character passed as the argument to New_Internal_Name). Loc is
-- the location for the Sloc value of the resulting Entity. Note that this
-- can be used for all kinds of temporary defining identifiers used in
-- expansion (objects, subtypes, functions etc).
--
-- Related_Node is used when the defining identifier is for an object that
-- captures the value of an expression (e.g. an aggregate). It should be
-- set whenever possible to point to the expression that is being captured.
-- This is provided to get better error messages, e.g. from CodePeer.
--
-- Make_Temp_Id would probably be a better name for this function???
function Make_Unsuppress_Block
(Loc : Source_Ptr;
Check : Name_Id;
Stmts : List_Id) return Node_Id;
-- Build a block with a pragma Suppress on 'Check'. Stmts is the statements
-- list that needs protection against the check
function New_Constraint_Error (Loc : Source_Ptr) return Node_Id;
-- This function builds a tree corresponding to the Ada statement
-- "raise Constraint_Error" and returns the root of this tree,
-- the N_Raise_Statement node.
function New_Op_Node
(New_Node_Kind : Node_Kind;
New_Sloc : Source_Ptr) return Node_Id;
-- Create node using New_Node and, if its kind is in N_Op, set its Chars
-- field accordingly.
function New_External_Name
(Related_Id : Name_Id;
Suffix : Character := ' ';
Suffix_Index : Int := 0;
Prefix : Character := ' ') return Name_Id;
function New_External_Name
(Related_Id : Name_Id;
Suffix : String;
Suffix_Index : Int := 0;
Prefix : Character := ' ') return Name_Id;
-- Builds a new entry in the names table of the form:
--
-- [Prefix &] Related_Id [& Suffix] [& Suffix_Index]
--
-- Prefix is prepended only if Prefix is non-blank (in which case it
-- must be an upper case letter other than O,Q,U,W (which are used for
-- identifier encoding, see Namet), or an underscore, and T is reserved for
-- use by implicit types, and X is reserved for use by debug type encoding
-- (see package Exp_Dbug). Note: the reason that Prefix is last is that it
-- is almost always omitted. The notable case of Prefix being non-null is
-- when it is 'T' for an implicit type.
-- Suffix_Index'Image is appended only if the value of Suffix_Index is
-- positive, or if Suffix_Index is negative 1, then a unique serialized
-- suffix is added. If Suffix_Index is zero, then no index is appended.
-- Suffix is also a single upper case letter other than O,Q,U,W,X and is a
-- required parameter (T is permitted). The constructed name is stored
-- using Name_Find so that it can be located using a subsequent Name_Find
-- operation (i.e. it is properly hashed into the names table). The upper
-- case letter given as the Suffix argument ensures that the name does
-- not clash with any Ada identifier name. These generated names are
-- permitted, but not required, to be made public by setting the flag
-- Is_Public in the associated entity.
function New_External_Name
(Suffix : Character;
Suffix_Index : Nat) return Name_Id;
-- Builds a new entry in the names table of the form
-- Suffix & Suffix_Index'Image
-- where Suffix is a single upper case letter other than O,Q,U,W,X and is
-- a required parameter (T is permitted). The constructed name is stored
-- using Name_Find so that it can be located using a subsequent Name_Find
-- operation (i.e. it is properly hashed into the names table). The upper
-- case letter given as the Suffix argument ensures that the name does
-- not clash with any Ada identifier name. These generated names are
-- permitted, but not required, to be made public by setting the flag
-- Is_Public in the associated entity.
function New_Internal_Name (Id_Char : Character) return Name_Id;
-- Id_Char is an upper case letter other than O,Q,U,W (which are reserved
-- for identifier encoding (see Namet package for details) and X which is
-- used for debug encoding (see Exp_Dbug). The letter T is permitted, but
-- is reserved by convention for the case of internally generated types.
-- The result of the call is a new generated unique name of the form XyyyU
-- where X is Id_Char, yyy is a unique serial number, and U is either a
-- lower case s or b indicating if the current unit is a spec or a body.
--
-- The name is entered into the names table using Name_Enter rather than
-- Name_Find, because there can never be a need to locate the entry using
-- the Name_Find procedure later on. Names created by New_Internal_Name
-- are guaranteed to be consistent from one compilation to another (i.e.
-- if the identical unit is compiled with a semantically consistent set
-- of sources, the numbers will be consistent. This means that it is fine
-- to use these as public symbols.
--
-- Note: Nearly all uses of this function are via calls to Make_Temporary,
-- but there are just a few cases where it is called directly.
function New_Occurrence_Of
(Def_Id : Entity_Id;
Loc : Source_Ptr) return Node_Id;
-- New_Occurrence_Of creates an N_Identifier node which is an occurrence
-- of the defining identifier which is passed as its argument. The Entity
-- and Etype of the result are set from the given defining identifier as
-- follows: Entity is simply a copy of Def_Id. Etype is a copy of Def_Id
-- for types, and a copy of the Etype of Def_Id for other entities.
function New_Reference_To
(Def_Id : Entity_Id;
Loc : Source_Ptr) return Node_Id;
-- This is like New_Occurrence_Of, but it does not set the Etype field. It
-- is used from the expander, where Etype fields are generally not set,
-- since they are set when the expanded tree is reanalyzed.
function New_Suffixed_Name
(Related_Id : Name_Id;
Suffix : String) return Name_Id;
-- This function is used to create special suffixed names used by the
-- debugger. Suffix is a string of upper case letters, used to construct
-- the required name. For instance, the special type used to record the
-- fixed-point small is called typ_SMALL where typ is the name of the
-- fixed-point type (as passed in Related_Id), and Suffix is "SMALL".
function OK_Convert_To (Typ : Entity_Id; Expr : Node_Id) return Node_Id;
-- Like Convert_To, except that a conversion node is always generated, and
-- the Conversion_OK flag is set on this conversion node.
function Unchecked_Convert_To
(Typ : Entity_Id;
Expr : Node_Id) return Node_Id;
-- Like Convert_To, but if a conversion is actually needed, constructs an
-- N_Unchecked_Type_Conversion node to do the required conversion.
end Tbuild;
|