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
47 ---------------------------------------------
48 -- Expand_N_Exception_Renaming_Declaration --
49 ---------------------------------------------
51 procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is
52 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
54 if Present (Decl) then
55 Insert_Action (N, Decl);
57 end Expand_N_Exception_Renaming_Declaration;
59 ------------------------------------------
60 -- Expand_N_Object_Renaming_Declaration --
61 ------------------------------------------
63 -- Most object renaming cases can be done by just capturing the address
64 -- of the renamed object. The cases in which this is not true are when
65 -- this address is not computable, since it involves extraction of a
66 -- packed array element, or of a record component to which a component
67 -- clause applies (that can specify an arbitrary bit boundary), or where
68 -- the enclosing record itself has a non-standard representation.
70 -- In these two cases, we pre-evaluate the renaming expression, by
71 -- extracting and freezing the values of any subscripts, and then we
72 -- set the flag Is_Renaming_Of_Object which means that any reference
73 -- to the object will be handled by macro substitution in the front
74 -- end, and the back end will know to ignore the renaming declaration.
76 -- An additional odd case that requires processing by expansion is
77 -- the renaming of a discriminant of a mutable record type. The object
78 -- is a constant because it renames something that cannot be assigned to,
79 -- but in fact the underlying value can change and must be reevaluated
80 -- at each reference. Gigi does have a notion of a "constant view" of
81 -- an object, and therefore the front-end must perform the expansion.
82 -- For simplicity, and to bypass some obscure code-generation problem,
83 -- we use macro substitution for all renamed discriminants, whether the
84 -- enclosing type is constrained or not.
86 -- The other special processing required is for the case of renaming
87 -- of an object of a class wide type, where it is necessary to build
88 -- the appropriate subtype for the renamed object.
89 -- More comments needed for this para ???
91 procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is
92 Nam : constant Node_Id := Name (N);
96 function Evaluation_Required (Nam : Node_Id) return Boolean;
97 -- Determines whether it is necessary to do static name evaluation for
98 -- renaming of Nam. It is considered necessary if evaluating the name
99 -- involves indexing a packed array, or extracting a component of a
100 -- record to which a component clause applies. Note that we are only
101 -- interested in these operations if they occur as part of the name
102 -- itself, subscripts are just values that are computed as part of the
103 -- evaluation, so their form is unimportant.
105 -------------------------
106 -- Evaluation_Required --
107 -------------------------
109 function Evaluation_Required (Nam : Node_Id) return Boolean is
111 if Nkind_In (Nam, N_Indexed_Component, N_Slice) then
112 if Is_Packed (Etype (Prefix (Nam))) then
115 return Evaluation_Required (Prefix (Nam));
118 elsif Nkind (Nam) = N_Selected_Component then
120 Rec_Type : constant Entity_Id := Etype (Prefix (Nam));
123 if Present (Component_Clause (Entity (Selector_Name (Nam))))
124 or else Has_Non_Standard_Rep (Rec_Type)
128 elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant
129 and then Is_Record_Type (Rec_Type)
130 and then not Is_Concurrent_Record_Type (Rec_Type)
135 return Evaluation_Required (Prefix (Nam));
142 end Evaluation_Required;
144 -- Start of processing for Expand_N_Object_Renaming_Declaration
147 -- Perform name evaluation if required
149 if Evaluation_Required (Nam) then
151 Set_Is_Renaming_Of_Object (Defining_Identifier (N));
154 -- Deal with construction of subtype in class-wide case
156 T := Etype (Defining_Identifier (N));
158 if Is_Class_Wide_Type (T) then
159 Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
160 Find_Type (Subtype_Mark (N));
161 Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
163 -- Freeze the class-wide subtype here to ensure that the subtype
164 -- and equivalent type are frozen before the renaming.
166 Freeze_Before (N, Entity (Subtype_Mark (N)));
169 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
170 -- place function, then a temporary return object needs to be created
171 -- and access to it must be passed to the function. Currently we limit
172 -- such functions to those with inherently limited result subtypes, but
173 -- eventually we plan to expand the functions that are treated as
174 -- build-in-place to include other composite result types.
176 if Ada_Version >= Ada_2005
177 and then Is_Build_In_Place_Function_Call (Nam)
179 Make_Build_In_Place_Call_In_Anonymous_Context (Nam);
182 -- Create renaming entry for debug information
184 Decl := Debug_Renaming_Declaration (N);
186 if Present (Decl) then
187 Insert_Action (N, Decl);
189 end Expand_N_Object_Renaming_Declaration;
191 -------------------------------------------
192 -- Expand_N_Package_Renaming_Declaration --
193 -------------------------------------------
195 procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is
196 Decl : constant Node_Id := Debug_Renaming_Declaration (N);
199 if Present (Decl) then
201 -- If we are in a compilation unit, then this is an outer
202 -- level declaration, and must have a scope of Standard
204 if Nkind (Parent (N)) = N_Compilation_Unit then
206 Aux : constant Node_Id := Aux_Decls_Node (Parent (N));
209 Push_Scope (Standard_Standard);
211 if No (Actions (Aux)) then
212 Set_Actions (Aux, New_List (Decl));
214 Append (Decl, Actions (Aux));
219 -- Enter the debug variable in the qualification list, which
220 -- must be done at this point because auxiliary declarations
221 -- occur at the library level and aren't associated with a
224 Qualify_Entity_Names (Decl);
229 -- Otherwise, just insert after the package declaration
232 Insert_Action (N, Decl);
235 end Expand_N_Package_Renaming_Declaration;
237 ----------------------------------------------
238 -- Expand_N_Subprogram_Renaming_Declaration --
239 ----------------------------------------------
241 procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is
242 Nam : constant Node_Id := Name (N);
245 -- When the prefix of the name is a function call, we must force the
246 -- call to be made by removing side effects from the call, since we
247 -- must only call the function once.
249 if Nkind (Nam) = N_Selected_Component
250 and then Nkind (Prefix (Nam)) = N_Function_Call
252 Remove_Side_Effects (Prefix (Nam));
254 -- For an explicit dereference, the prefix must be captured to prevent
255 -- reevaluation on calls through the renaming, which could result in
256 -- calling the wrong subprogram if the access value were to be changed.
258 elsif Nkind (Nam) = N_Explicit_Dereference then
259 Force_Evaluation (Prefix (Nam));
262 -- Check whether this is a renaming of a predefined equality on an
263 -- untagged record type (AI05-0123).
265 if Is_Entity_Name (Nam)
266 and then Chars (Entity (Nam)) = Name_Op_Eq
267 and then Scope (Entity (Nam)) = Standard_Standard
268 and then Ada_Version >= Ada_2012
271 Loc : constant Source_Ptr := Sloc (N);
272 Id : constant Entity_Id := Defining_Entity (N);
273 Typ : constant Entity_Id := Etype (First_Formal (Id));
276 Body_Id : constant Entity_Id :=
277 Make_Defining_Identifier (Sloc (N), Chars (Id));
280 if Is_Record_Type (Typ)
281 and then not Is_Tagged_Type (Typ)
282 and then not Is_Frozen (Typ)
284 -- Build body for renamed equality, to capture its current
285 -- meaning. It may be redefined later, but the renaming is
286 -- elaborated where it occurs. This is technically known as
287 -- Squirreling semantics. Renaming is rewritten as a subprogram
288 -- declaration, and the body is inserted at the end of the
289 -- current declaration list to prevent premature freezing.
291 Set_Alias (Id, Empty);
292 Set_Has_Completion (Id, False);
294 Make_Subprogram_Declaration (Sloc (N),
295 Specification => Specification (N)));
296 Set_Has_Delayed_Freeze (Id);
298 Decl := Make_Subprogram_Body (Loc,
300 Make_Function_Specification (Loc,
301 Defining_Unit_Name => Body_Id,
302 Parameter_Specifications =>
303 Copy_Parameter_List (Id),
305 New_Occurrence_Of (Standard_Boolean, Loc)),
306 Declarations => Empty_List,
307 Handled_Statement_Sequence => Empty);
309 Set_Handled_Statement_Sequence (Decl,
310 Make_Handled_Sequence_Of_Statements (Loc,
311 Statements => New_List (
312 Make_Simple_Return_Statement (Loc,
314 Expand_Record_Equality
318 Make_Identifier (Loc, Chars (First_Formal (Id))),
321 (Loc, Chars (Next_Formal (First_Formal (Id)))),
322 Bodies => Declarations (Decl))))));
324 Append (Decl, List_Containing (N));
325 Set_Debug_Info_Needed (Body_Id);
329 end Expand_N_Subprogram_Renaming_Declaration;