1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, 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_Ch4; use Exp_Ch4;
29 with Exp_Ch6; use Exp_Ch6;
30 with Exp_Dbug; use Exp_Dbug;
31 with Exp_Util; use Exp_Util;
32 with Freeze; use Freeze;
33 with Namet; use Namet;
34 with Nmake; use Nmake;
35 with Nlists; use Nlists;
38 with Sem_Ch8; use Sem_Ch8;
39 with Sem_Util; use Sem_Util;
40 with Sinfo; use Sinfo;
41 with Snames; use Snames;
42 with Stand; use Stand;
43 with Tbuild; use Tbuild;
45 package body Exp_Ch8 is
51 procedure Evaluate_Name (Nam : Node_Id) is
52 K : constant Node_Kind := Nkind (Nam);
55 -- For an explicit dereference, we simply force the evaluation of the
56 -- name expression. The dereference provides a value that is the address
57 -- for the renamed object, and it is precisely this value that we want
60 if K = N_Explicit_Dereference then
61 Force_Evaluation (Prefix (Nam));
63 -- For a selected component, we simply evaluate the prefix
65 elsif K = N_Selected_Component then
66 Evaluate_Name (Prefix (Nam));
68 -- For an indexed component, or an attribute reference, we evaluate the
69 -- prefix, which is itself a name, recursively, and then force the
70 -- evaluation of all the subscripts (or attribute expressions).
72 elsif Nkind_In (K, N_Indexed_Component, N_Attribute_Reference) then
73 Evaluate_Name (Prefix (Nam));
79 E := First (Expressions (Nam));
80 while Present (E) loop
83 if Original_Node (E) /= E then
84 Set_Do_Range_Check (E, Do_Range_Check (Original_Node (E)));
91 -- For a slice, we evaluate the prefix, as for the indexed component
92 -- case and then, if there is a range present, either directly or as the
93 -- constraint of a discrete subtype indication, we evaluate the two
94 -- bounds of this range.
96 elsif K = N_Slice then
97 Evaluate_Name (Prefix (Nam));
100 DR : constant Node_Id := Discrete_Range (Nam);
105 if Nkind (DR) = N_Range then
106 Force_Evaluation (Low_Bound (DR));
107 Force_Evaluation (High_Bound (DR));
109 elsif Nkind (DR) = N_Subtype_Indication then
110 Constr := Constraint (DR);
112 if Nkind (Constr) = N_Range_Constraint then
113 Rexpr := Range_Expression (Constr);
115 Force_Evaluation (Low_Bound (Rexpr));
116 Force_Evaluation (High_Bound (Rexpr));
121 -- For a type conversion, the expression of the conversion must be the
122 -- name of an object, and we simply need to evaluate this name.
124 elsif K = N_Type_Conversion then
125 Evaluate_Name (Expression (Nam));
127 -- For a function call, we evaluate the call
129 elsif K = N_Function_Call then
130 Force_Evaluation (Nam);
132 -- The remaining cases are direct name, operator symbol and character
133 -- literal. In all these cases, we do nothing, since we want to
134 -- reevaluate each time the renamed object is used.
141 ---------------------------------------------
142 -- Expand_N_Exception_Renaming_Declaration --
143 ---------------------------------------------
145 procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is
146 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
149 if Present (Decl) then
150 Insert_Action (N, Decl);
152 end Expand_N_Exception_Renaming_Declaration;
154 ------------------------------------------
155 -- Expand_N_Object_Renaming_Declaration --
156 ------------------------------------------
158 -- Most object renaming cases can be done by just capturing the address
159 -- of the renamed object. The cases in which this is not true are when
160 -- this address is not computable, since it involves extraction of a
161 -- packed array element, or of a record component to which a component
162 -- clause applies (that can specify an arbitrary bit boundary), or where
163 -- the enclosing record itself has a non-standard representation.
165 -- In these two cases, we pre-evaluate the renaming expression, by
166 -- extracting and freezing the values of any subscripts, and then we
167 -- set the flag Is_Renaming_Of_Object which means that any reference
168 -- to the object will be handled by macro substitution in the front
169 -- end, and the back end will know to ignore the renaming declaration.
171 -- An additional odd case that requires processing by expansion is
172 -- the renaming of a discriminant of a mutable record type. The object
173 -- is a constant because it renames something that cannot be assigned to,
174 -- but in fact the underlying value can change and must be reevaluated
175 -- at each reference. Gigi does have a notion of a "constant view" of
176 -- an object, and therefore the front-end must perform the expansion.
177 -- For simplicity, and to bypass some obscure code-generation problem,
178 -- we use macro substitution for all renamed discriminants, whether the
179 -- enclosing type is constrained or not.
181 -- The other special processing required is for the case of renaming
182 -- of an object of a class wide type, where it is necessary to build
183 -- the appropriate subtype for the renamed object.
184 -- More comments needed for this para ???
186 procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
187 Nam : constant Node_Id := Name (N);
191 function Evaluation_Required (Nam : Node_Id) return Boolean;
192 -- Determines whether it is necessary to do static name evaluation for
193 -- renaming of Nam. It is considered necessary if evaluating the name
194 -- involves indexing a packed array, or extracting a component of a
195 -- record to which a component clause applies. Note that we are only
196 -- interested in these operations if they occur as part of the name
197 -- itself, subscripts are just values that are computed as part of the
198 -- evaluation, so their form is unimportant.
200 -------------------------
201 -- Evaluation_Required --
202 -------------------------
204 function Evaluation_Required (Nam : Node_Id) return Boolean is
206 if Nkind_In (Nam, N_Indexed_Component, N_Slice) then
207 if Is_Packed (Etype (Prefix (Nam))) then
210 return Evaluation_Required (Prefix (Nam));
213 elsif Nkind (Nam) = N_Selected_Component then
215 Rec_Type : constant Entity_Id := Etype (Prefix (Nam));
218 if Present (Component_Clause (Entity (Selector_Name (Nam))))
219 or else Has_Non_Standard_Rep (Rec_Type)
223 elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
224 and then Is_Record_Type (Rec_Type)
225 and then not Is_Concurrent_Record_Type (Rec_Type)
230 return Evaluation_Required (Prefix (Nam));
237 end Evaluation_Required;
239 -- Start of processing for Expand_N_Object_Renaming_Declaration
242 -- Perform name evaluation if required
244 if Evaluation_Required (Nam) then
246 Set_Is_Renaming_Of_Object (Defining_Identifier (N));
249 -- Deal with construction of subtype in class-wide case
251 T := Etype (Defining_Identifier (N));
253 if Is_Class_Wide_Type (T) then
254 Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
255 Find_Type (Subtype_Mark (N));
256 Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
258 -- Freeze the class-wide subtype here to ensure that the subtype
259 -- and equivalent type are frozen before the renaming.
261 Freeze_Before (N, Entity (Subtype_Mark (N)));
264 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
265 -- place function, then a temporary return object needs to be created
266 -- and access to it must be passed to the function. Currently we limit
267 -- such functions to those with inherently limited result subtypes, but
268 -- eventually we plan to expand the functions that are treated as
269 -- build-in-place to include other composite result types.
271 if Ada_Version >= Ada_2005
272 and then Is_Build_In_Place_Function_Call (Nam)
274 Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
277 -- Create renaming entry for debug information
279 Decl := Debug_Renaming_Declaration (N);
281 if Present (Decl) then
282 Insert_Action (N, Decl);
284 end Expand_N_Object_Renaming_Declaration;
286 -------------------------------------------
287 -- Expand_N_Package_Renaming_Declaration --
288 -------------------------------------------
290 procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is
291 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
294 if Present (Decl) then
296 -- If we are in a compilation unit, then this is an outer
297 -- level declaration, and must have a scope of Standard
299 if Nkind (Parent (N)) = N_Compilation_Unit then
301 Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
304 Push_Scope (Standard_Standard);
306 if No (Actions (Aux)) then
307 Set_Actions (Aux, New_List (Decl));
309 Append (Decl, Actions (Aux));
314 -- Enter the debug variable in the qualification list, which
315 -- must be done at this point because auxiliary declarations
316 -- occur at the library level and aren't associated with a
319 Qualify_Entity_Names (Decl);
324 -- Otherwise, just insert after the package declaration
327 Insert_Action (N, Decl);
330 end Expand_N_Package_Renaming_Declaration;
332 ----------------------------------------------
333 -- Expand_N_Subprogram_Renaming_Declaration --
334 ----------------------------------------------
336 procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is
337 Nam : constant Node_Id := Name (N);
340 -- When the prefix of the name is a function call, we must force the
341 -- call to be made by removing side effects from the call, since we
342 -- must only call the function once.
344 if Nkind (Nam) = N_Selected_Component
345 and then Nkind (Prefix (Nam)) = N_Function_Call
347 Remove_Side_Effects (Prefix (Nam));
349 -- For an explicit dereference, the prefix must be captured to prevent
350 -- reevaluation on calls through the renaming, which could result in
351 -- calling the wrong subprogram if the access value were to be changed.
353 elsif Nkind (Nam) = N_Explicit_Dereference then
354 Force_Evaluation (Prefix (Nam));
357 -- Check whether this is a renaming of a predefined equality on an
358 -- untagged record type (AI05-0123).
360 if Is_Entity_Name (Nam)
361 and then Chars (Entity (Nam)) = Name_Op_Eq
362 and then Scope (Entity (Nam)) = Standard_Standard
363 and then Ada_Version >= Ada_2012
366 Loc : constant Source_Ptr := Sloc (N);
367 Id : constant Entity_Id := Defining_Entity (N);
368 Typ : constant Entity_Id := Etype (First_Formal (Id));
371 Body_Id : constant Entity_Id :=
372 Make_Defining_Identifier (Sloc (N), Chars (Id));
375 if Is_Record_Type (Typ)
376 and then not Is_Tagged_Type (Typ)
377 and then not Is_Frozen (Typ)
379 -- Build body for renamed equality, to capture its current
380 -- meaning. It may be redefined later, but the renaming is
381 -- elaborated where it occurs. This is technically known as
382 -- Squirreling semantics. Renaming is rewritten as a subprogram
383 -- declaration, and the body is inserted at the end of the
384 -- current declaration list to prevent premature freezing.
386 Set_Alias (Id, Empty);
387 Set_Has_Completion (Id, False);
389 Make_Subprogram_Declaration (Sloc (N),
390 Specification => Specification (N)));
391 Set_Has_Delayed_Freeze (Id);
393 Decl := Make_Subprogram_Body (Loc,
395 Make_Function_Specification (Loc,
396 Defining_Unit_Name => Body_Id,
397 Parameter_Specifications =>
398 Copy_Parameter_List (Id),
400 New_Occurrence_Of (Standard_Boolean, Loc)),
401 Declarations => Empty_List,
402 Handled_Statement_Sequence => Empty);
404 Set_Handled_Statement_Sequence (Decl,
405 Make_Handled_Sequence_Of_Statements (Loc,
406 Statements => New_List (
407 Make_Simple_Return_Statement (Loc,
409 Expand_Record_Equality
413 Make_Identifier (Loc, Chars (First_Formal (Id))),
416 (Loc, Chars (Next_Formal (First_Formal (Id)))),
417 Bodies => Declarations (Decl))))));
419 Append (Decl, List_Containing (N));
420 Set_Debug_Info_Needed (Body_Id);
424 end Expand_N_Subprogram_Renaming_Declaration;