1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Einfo
; use Einfo
;
28 with Exp_Ch6
; use Exp_Ch6
;
29 with Exp_Dbug
; use Exp_Dbug
;
30 with Exp_Util
; use Exp_Util
;
31 with Freeze
; use Freeze
;
32 with Nlists
; use Nlists
;
35 with Sem_Ch8
; use Sem_Ch8
;
36 with Sinfo
; use Sinfo
;
37 with Stand
; use Stand
;
39 package body Exp_Ch8
is
41 ---------------------------------------------
42 -- Expand_N_Exception_Renaming_Declaration --
43 ---------------------------------------------
45 procedure Expand_N_Exception_Renaming_Declaration
(N
: Node_Id
) is
46 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
49 if Present
(Decl
) then
50 Insert_Action
(N
, Decl
);
52 end Expand_N_Exception_Renaming_Declaration
;
54 ------------------------------------------
55 -- Expand_N_Object_Renaming_Declaration --
56 ------------------------------------------
58 -- Most object renaming cases can be done by just capturing the address
59 -- of the renamed object. The cases in which this is not true are when
60 -- this address is not computable, since it involves extraction of a
61 -- packed array element, or of a record component to which a component
62 -- clause applies (that can specify an arbitrary bit boundary), or where
63 -- the enclosing record itself has a non-standard representation.
65 -- In these two cases, we pre-evaluate the renaming expression, by
66 -- extracting and freezing the values of any subscripts, and then we
67 -- set the flag Is_Renaming_Of_Object which means that any reference
68 -- to the object will be handled by macro substitution in the front
69 -- end, and the back end will know to ignore the renaming declaration.
71 -- An additional odd case that requires processing by expansion is
72 -- the renaming of a discriminant of a mutable record type. The object
73 -- is a constant because it renames something that cannot be assigned to,
74 -- but in fact the underlying value can change and must be reevaluated
75 -- at each reference. Gigi does have a notion of a "constant view" of
76 -- an object, and therefore the front-end must perform the expansion.
77 -- For simplicity, and to bypass some obscure code-generation problem,
78 -- we use macro substitution for all renamed discriminants, whether the
79 -- enclosing type is constrained or not.
81 -- The other special processing required is for the case of renaming
82 -- of an object of a class wide type, where it is necessary to build
83 -- the appropriate subtype for the renamed object.
84 -- More comments needed for this para ???
86 procedure Expand_N_Object_Renaming_Declaration
(N
: Node_Id
) is
87 Nam
: constant Node_Id
:= Name
(N
);
91 procedure Evaluate_Name
(Fname
: Node_Id
);
92 -- A recursive procedure used to freeze a name in the sense described
93 -- above, i.e. any variable references or function calls are removed.
94 -- Of course the outer level variable reference must not be removed.
95 -- For example in A(J,F(K)), A is left as is, but J and F(K) are
96 -- evaluated and removed.
98 function Evaluation_Required
(Nam
: Node_Id
) return Boolean;
99 -- Determines whether it is necessary to do static name evaluation
100 -- for renaming of Nam. It is considered necessary if evaluating the
101 -- name involves indexing a packed array, or extracting a component
102 -- of a record to which a component clause applies. Note that we are
103 -- only interested in these operations if they occur as part of the
104 -- name itself, subscripts are just values that are computed as part
105 -- of the evaluation, so their form is unimportant.
111 procedure Evaluate_Name
(Fname
: Node_Id
) is
112 K
: constant Node_Kind
:= Nkind
(Fname
);
116 -- For an explicit dereference, we simply force the evaluation
117 -- of the name expression. The dereference provides a value that
118 -- is the address for the renamed object, and it is precisely
119 -- this value that we want to preserve.
121 if K
= N_Explicit_Dereference
then
122 Force_Evaluation
(Prefix
(Fname
));
124 -- For a selected component, we simply evaluate the prefix
126 elsif K
= N_Selected_Component
then
127 Evaluate_Name
(Prefix
(Fname
));
129 -- For an indexed component, or an attribute reference, we evaluate
130 -- the prefix, which is itself a name, recursively, and then force
131 -- the evaluation of all the subscripts (or attribute expressions).
133 elsif Nkind_In
(K
, N_Indexed_Component
, N_Attribute_Reference
) then
134 Evaluate_Name
(Prefix
(Fname
));
136 E
:= First
(Expressions
(Fname
));
137 while Present
(E
) loop
138 Force_Evaluation
(E
);
140 if Original_Node
(E
) /= E
then
141 Set_Do_Range_Check
(E
, Do_Range_Check
(Original_Node
(E
)));
147 -- For a slice, we evaluate the prefix, as for the indexed component
148 -- case and then, if there is a range present, either directly or
149 -- as the constraint of a discrete subtype indication, we evaluate
150 -- the two bounds of this range.
152 elsif K
= N_Slice
then
153 Evaluate_Name
(Prefix
(Fname
));
156 DR
: constant Node_Id
:= Discrete_Range
(Fname
);
161 if Nkind
(DR
) = N_Range
then
162 Force_Evaluation
(Low_Bound
(DR
));
163 Force_Evaluation
(High_Bound
(DR
));
165 elsif Nkind
(DR
) = N_Subtype_Indication
then
166 Constr
:= Constraint
(DR
);
168 if Nkind
(Constr
) = N_Range_Constraint
then
169 Rexpr
:= Range_Expression
(Constr
);
171 Force_Evaluation
(Low_Bound
(Rexpr
));
172 Force_Evaluation
(High_Bound
(Rexpr
));
177 -- For a type conversion, the expression of the conversion must be
178 -- the name of an object, and we simply need to evaluate this name.
180 elsif K
= N_Type_Conversion
then
181 Evaluate_Name
(Expression
(Fname
));
183 -- For a function call, we evaluate the call
185 elsif K
= N_Function_Call
then
186 Force_Evaluation
(Fname
);
188 -- The remaining cases are direct name, operator symbol and
189 -- character literal. In all these cases, we do nothing, since
190 -- we want to reevaluate each time the renamed object is used.
197 -------------------------
198 -- Evaluation_Required --
199 -------------------------
201 function Evaluation_Required
(Nam
: Node_Id
) return Boolean is
203 if Nkind_In
(Nam
, N_Indexed_Component
, N_Slice
) then
204 if Is_Packed
(Etype
(Prefix
(Nam
))) then
207 return Evaluation_Required
(Prefix
(Nam
));
210 elsif Nkind
(Nam
) = N_Selected_Component
then
212 Rec_Type
: constant Entity_Id
:= Etype
(Prefix
(Nam
));
215 if Present
(Component_Clause
(Entity
(Selector_Name
(Nam
))))
216 or else Has_Non_Standard_Rep
(Rec_Type
)
220 elsif Ekind
(Entity
(Selector_Name
(Nam
))) = E_Discriminant
221 and then Is_Record_Type
(Rec_Type
)
222 and then not Is_Concurrent_Record_Type
(Rec_Type
)
227 return Evaluation_Required
(Prefix
(Nam
));
234 end Evaluation_Required
;
236 -- Start of processing for Expand_N_Object_Renaming_Declaration
239 -- Perform name evaluation if required
241 if Evaluation_Required
(Nam
) then
243 Set_Is_Renaming_Of_Object
(Defining_Identifier
(N
));
246 -- Deal with construction of subtype in class-wide case
248 T
:= Etype
(Defining_Identifier
(N
));
250 if Is_Class_Wide_Type
(T
) then
251 Expand_Subtype_From_Expr
(N
, T
, Subtype_Mark
(N
), Name
(N
));
252 Find_Type
(Subtype_Mark
(N
));
253 Set_Etype
(Defining_Identifier
(N
), Entity
(Subtype_Mark
(N
)));
255 -- Freeze the class-wide subtype here to ensure that the subtype
256 -- and equivalent type are frozen before the renaming.
258 Freeze_Before
(N
, Entity
(Subtype_Mark
(N
)));
261 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
262 -- place function, then a temporary return object needs to be created
263 -- and access to it must be passed to the function. Currently we limit
264 -- such functions to those with inherently limited result subtypes, but
265 -- eventually we plan to expand the functions that are treated as
266 -- build-in-place to include other composite result types.
268 if Ada_Version
>= Ada_05
269 and then Is_Build_In_Place_Function_Call
(Nam
)
271 Make_Build_In_Place_Call_In_Anonymous_Context
(Nam
);
274 -- Create renaming entry for debug information
276 Decl
:= Debug_Renaming_Declaration
(N
);
278 if Present
(Decl
) then
279 Insert_Action
(N
, Decl
);
281 end Expand_N_Object_Renaming_Declaration
;
283 -------------------------------------------
284 -- Expand_N_Package_Renaming_Declaration --
285 -------------------------------------------
287 procedure Expand_N_Package_Renaming_Declaration
(N
: Node_Id
) is
288 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
291 if Present
(Decl
) then
293 -- If we are in a compilation unit, then this is an outer
294 -- level declaration, and must have a scope of Standard
296 if Nkind
(Parent
(N
)) = N_Compilation_Unit
then
298 Aux
: constant Node_Id
:= Aux_Decls_Node
(Parent
(N
));
301 Push_Scope
(Standard_Standard
);
303 if No
(Actions
(Aux
)) then
304 Set_Actions
(Aux
, New_List
(Decl
));
306 Append
(Decl
, Actions
(Aux
));
311 -- Enter the debug variable in the qualification list, which
312 -- must be done at this point because auxiliary declarations
313 -- occur at the library level and aren't associated with a
316 Qualify_Entity_Names
(Decl
);
321 -- Otherwise, just insert after the package declaration
324 Insert_Action
(N
, Decl
);
327 end Expand_N_Package_Renaming_Declaration
;
329 ----------------------------------------------
330 -- Expand_N_Subprogram_Renaming_Declaration --
331 ----------------------------------------------
333 procedure Expand_N_Subprogram_Renaming_Declaration
(N
: Node_Id
) is
334 Nam
: constant Node_Id
:= Name
(N
);
337 -- When the prefix of the name is a function call, we must force the
338 -- call to be made by removing side effects from the call, since we
339 -- must only call the function once.
341 if Nkind
(Nam
) = N_Selected_Component
342 and then Nkind
(Prefix
(Nam
)) = N_Function_Call
344 Remove_Side_Effects
(Prefix
(Nam
));
346 -- For an explicit dereference, the prefix must be captured to prevent
347 -- reevaluation on calls through the renaming, which could result in
348 -- calling the wrong subprogram if the access value were to be changed.
350 elsif Nkind
(Nam
) = N_Explicit_Dereference
then
351 Force_Evaluation
(Prefix
(Nam
));
353 end Expand_N_Subprogram_Renaming_Declaration
;