1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2015, 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 Ghost
; use Ghost
;
34 with Namet
; use Namet
;
35 with Nmake
; use Nmake
;
36 with Nlists
; use Nlists
;
39 with Sem_Ch8
; use Sem_Ch8
;
40 with Sem_Util
; use Sem_Util
;
41 with Sinfo
; use Sinfo
;
42 with Snames
; use Snames
;
43 with Stand
; use Stand
;
44 with Tbuild
; use Tbuild
;
46 package body Exp_Ch8
is
48 ---------------------------------------------
49 -- Expand_N_Exception_Renaming_Declaration --
50 ---------------------------------------------
52 procedure Expand_N_Exception_Renaming_Declaration
(N
: Node_Id
) is
53 Save_Ghost_Mode
: constant Ghost_Mode_Type
:= Ghost_Mode
;
58 -- The exception renaming declaration is Ghost when it is subject to
59 -- pragma Ghost or renames a Ghost entity. To accomodate both cases, set
60 -- the mode now to ensure that any nodes generated during expansion are
61 -- properly marked as Ghost.
65 Decl
:= Debug_Renaming_Declaration
(N
);
67 if Present
(Decl
) then
68 Insert_Action
(N
, Decl
);
71 Ghost_Mode
:= Save_Ghost_Mode
;
72 end Expand_N_Exception_Renaming_Declaration
;
74 ------------------------------------------
75 -- Expand_N_Object_Renaming_Declaration --
76 ------------------------------------------
78 -- Most object renaming cases can be done by just capturing the address
79 -- of the renamed object. The cases in which this is not true are when
80 -- this address is not computable, since it involves extraction of a
81 -- packed array element, or of a record component to which a component
82 -- clause applies (that can specify an arbitrary bit boundary), or where
83 -- the enclosing record itself has a non-standard representation.
85 -- In these two cases, we pre-evaluate the renaming expression, by
86 -- extracting and freezing the values of any subscripts, and then we
87 -- set the flag Is_Renaming_Of_Object which means that any reference
88 -- to the object will be handled by macro substitution in the front
89 -- end, and the back end will know to ignore the renaming declaration.
91 -- An additional odd case that requires processing by expansion is
92 -- the renaming of a discriminant of a mutable record type. The object
93 -- is a constant because it renames something that cannot be assigned to,
94 -- but in fact the underlying value can change and must be reevaluated
95 -- at each reference. Gigi does have a notion of a "constant view" of
96 -- an object, and therefore the front-end must perform the expansion.
97 -- For simplicity, and to bypass some obscure code-generation problem,
98 -- we use macro substitution for all renamed discriminants, whether the
99 -- enclosing type is constrained or not.
101 -- The other special processing required is for the case of renaming
102 -- of an object of a class wide type, where it is necessary to build
103 -- the appropriate subtype for the renamed object.
104 -- More comments needed for this para ???
106 procedure Expand_N_Object_Renaming_Declaration
(N
: Node_Id
) is
107 Nam
: constant Node_Id
:= Name
(N
);
111 function Evaluation_Required
(Nam
: Node_Id
) return Boolean;
112 -- Determines whether it is necessary to do static name evaluation for
113 -- renaming of Nam. It is considered necessary if evaluating the name
114 -- involves indexing a packed array, or extracting a component of a
115 -- record to which a component clause applies. Note that we are only
116 -- interested in these operations if they occur as part of the name
117 -- itself, subscripts are just values that are computed as part of the
118 -- evaluation, so their form is unimportant.
120 -------------------------
121 -- Evaluation_Required --
122 -------------------------
124 function Evaluation_Required
(Nam
: Node_Id
) return Boolean is
126 if Nkind_In
(Nam
, N_Indexed_Component
, N_Slice
) then
127 if Is_Packed
(Etype
(Prefix
(Nam
))) then
130 return Evaluation_Required
(Prefix
(Nam
));
133 elsif Nkind
(Nam
) = N_Selected_Component
then
135 Rec_Type
: constant Entity_Id
:= Etype
(Prefix
(Nam
));
138 if Present
(Component_Clause
(Entity
(Selector_Name
(Nam
))))
139 or else Has_Non_Standard_Rep
(Rec_Type
)
143 elsif Ekind
(Entity
(Selector_Name
(Nam
))) = E_Discriminant
144 and then Is_Record_Type
(Rec_Type
)
145 and then not Is_Concurrent_Record_Type
(Rec_Type
)
150 return Evaluation_Required
(Prefix
(Nam
));
157 end Evaluation_Required
;
161 Save_Ghost_Mode
: constant Ghost_Mode_Type
:= Ghost_Mode
;
163 -- Start of processing for Expand_N_Object_Renaming_Declaration
166 -- The object renaming declaration is Ghost when it is subject to pragma
167 -- Ghost or renames a Ghost entity. To accomodate both cases, set the
168 -- mode now to ensure that any nodes generated during expansion are
169 -- properly marked as Ghost.
173 -- Perform name evaluation if required
175 if Evaluation_Required
(Nam
) then
177 Set_Is_Renaming_Of_Object
(Defining_Identifier
(N
));
180 -- Deal with construction of subtype in class-wide case
182 T
:= Etype
(Defining_Identifier
(N
));
184 if Is_Class_Wide_Type
(T
) then
185 Expand_Subtype_From_Expr
(N
, T
, Subtype_Mark
(N
), Name
(N
));
186 Find_Type
(Subtype_Mark
(N
));
187 Set_Etype
(Defining_Identifier
(N
), Entity
(Subtype_Mark
(N
)));
189 -- Freeze the class-wide subtype here to ensure that the subtype
190 -- and equivalent type are frozen before the renaming.
192 Freeze_Before
(N
, Entity
(Subtype_Mark
(N
)));
195 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
196 -- place function, then a temporary return object needs to be created
197 -- and access to it must be passed to the function. Currently we limit
198 -- such functions to those with inherently limited result subtypes, but
199 -- eventually we plan to expand the functions that are treated as
200 -- build-in-place to include other composite result types.
202 if Ada_Version
>= Ada_2005
203 and then Is_Build_In_Place_Function_Call
(Nam
)
205 Make_Build_In_Place_Call_In_Anonymous_Context
(Nam
);
208 -- Create renaming entry for debug information
210 Decl
:= Debug_Renaming_Declaration
(N
);
212 if Present
(Decl
) then
213 Insert_Action
(N
, Decl
);
216 Ghost_Mode
:= Save_Ghost_Mode
;
217 end Expand_N_Object_Renaming_Declaration
;
219 -------------------------------------------
220 -- Expand_N_Package_Renaming_Declaration --
221 -------------------------------------------
223 procedure Expand_N_Package_Renaming_Declaration
(N
: Node_Id
) is
224 Save_Ghost_Mode
: constant Ghost_Mode_Type
:= Ghost_Mode
;
229 -- The package renaming declaration is Ghost when it is subject to
230 -- pragma Ghost or renames a Ghost entity. To accomodate both cases,
231 -- set the mode now to ensure that any nodes generated during expansion
232 -- are properly marked as Ghost.
236 Decl
:= Debug_Renaming_Declaration
(N
);
238 if Present
(Decl
) then
240 -- If we are in a compilation unit, then this is an outer
241 -- level declaration, and must have a scope of Standard
243 if Nkind
(Parent
(N
)) = N_Compilation_Unit
then
245 Aux
: constant Node_Id
:= Aux_Decls_Node
(Parent
(N
));
248 Push_Scope
(Standard_Standard
);
250 if No
(Actions
(Aux
)) then
251 Set_Actions
(Aux
, New_List
(Decl
));
253 Append
(Decl
, Actions
(Aux
));
258 -- Enter the debug variable in the qualification list, which
259 -- must be done at this point because auxiliary declarations
260 -- occur at the library level and aren't associated with a
263 Qualify_Entity_Names
(Decl
);
268 -- Otherwise, just insert after the package declaration
271 Insert_Action
(N
, Decl
);
275 Ghost_Mode
:= Save_Ghost_Mode
;
276 end Expand_N_Package_Renaming_Declaration
;
278 ----------------------------------------------
279 -- Expand_N_Subprogram_Renaming_Declaration --
280 ----------------------------------------------
282 procedure Expand_N_Subprogram_Renaming_Declaration
(N
: Node_Id
) is
283 Loc
: constant Source_Ptr
:= Sloc
(N
);
284 Id
: constant Entity_Id
:= Defining_Entity
(N
);
286 function Build_Body_For_Renaming
return Node_Id
;
287 -- Build and return the body for the renaming declaration of an equality
288 -- or inequality operator.
290 -----------------------------
291 -- Build_Body_For_Renaming --
292 -----------------------------
294 function Build_Body_For_Renaming
return Node_Id
is
299 Set_Alias
(Id
, Empty
);
300 Set_Has_Completion
(Id
, False);
302 Make_Subprogram_Declaration
(Sloc
(N
),
303 Specification
=> Specification
(N
)));
304 Set_Has_Delayed_Freeze
(Id
);
306 Body_Id
:= Make_Defining_Identifier
(Sloc
(N
), Chars
(Id
));
307 Set_Debug_Info_Needed
(Body_Id
);
310 Make_Subprogram_Body
(Loc
,
312 Make_Function_Specification
(Loc
,
313 Defining_Unit_Name
=> Body_Id
,
314 Parameter_Specifications
=> Copy_Parameter_List
(Id
),
316 New_Occurrence_Of
(Standard_Boolean
, Loc
)),
317 Declarations
=> Empty_List
,
318 Handled_Statement_Sequence
=> Empty
);
321 end Build_Body_For_Renaming
;
325 Nam
: constant Node_Id
:= Name
(N
);
326 Save_Ghost_Mode
: constant Ghost_Mode_Type
:= Ghost_Mode
;
328 -- Start of processing for Expand_N_Subprogram_Renaming_Declaration
331 -- The subprogram renaming declaration is Ghost when it is subject to
332 -- pragma Ghost or renames a Ghost entity. To accomodate both cases, set
333 -- the mode now to ensure that any nodes created during expansion are
334 -- properly flagged as ignored Ghost.
338 -- When the prefix of the name is a function call, we must force the
339 -- call to be made by removing side effects from the call, since we
340 -- must only call the function once.
342 if Nkind
(Nam
) = N_Selected_Component
343 and then Nkind
(Prefix
(Nam
)) = N_Function_Call
345 Remove_Side_Effects
(Prefix
(Nam
));
347 -- For an explicit dereference, the prefix must be captured to prevent
348 -- reevaluation on calls through the renaming, which could result in
349 -- calling the wrong subprogram if the access value were to be changed.
351 elsif Nkind
(Nam
) = N_Explicit_Dereference
then
352 Force_Evaluation
(Prefix
(Nam
));
355 -- Handle cases where we build a body for a renamed equality
357 if Is_Entity_Name
(Nam
)
358 and then Chars
(Entity
(Nam
)) = Name_Op_Eq
359 and then Scope
(Entity
(Nam
)) = Standard_Standard
362 Left
: constant Entity_Id
:= First_Formal
(Id
);
363 Right
: constant Entity_Id
:= Next_Formal
(Left
);
364 Typ
: constant Entity_Id
:= Etype
(Left
);
368 -- Check whether this is a renaming of a predefined equality on an
369 -- untagged record type (AI05-0123).
371 if Ada_Version
>= Ada_2012
372 and then Is_Record_Type
(Typ
)
373 and then not Is_Tagged_Type
(Typ
)
374 and then not Is_Frozen
(Typ
)
376 -- Build body for renamed equality, to capture its current
377 -- meaning. It may be redefined later, but the renaming is
378 -- elaborated where it occurs. This is technically known as
379 -- Squirreling semantics. Renaming is rewritten as a subprogram
380 -- declaration, and the generated body is inserted into the
381 -- freeze actions for the subprogram.
383 Decl
:= Build_Body_For_Renaming
;
385 Set_Handled_Statement_Sequence
(Decl
,
386 Make_Handled_Sequence_Of_Statements
(Loc
,
387 Statements
=> New_List
(
388 Make_Simple_Return_Statement
(Loc
,
390 Expand_Record_Equality
393 Lhs
=> Make_Identifier
(Loc
, Chars
(Left
)),
394 Rhs
=> Make_Identifier
(Loc
, Chars
(Right
)),
395 Bodies
=> Declarations
(Decl
))))));
397 Append_Freeze_Action
(Id
, Decl
);
402 Ghost_Mode
:= Save_Ghost_Mode
;
403 end Expand_N_Subprogram_Renaming_Declaration
;