1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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
);
55 if Present
(Decl
) then
56 Insert_Action
(N
, Decl
);
58 end Expand_N_Exception_Renaming_Declaration
;
60 ------------------------------------------
61 -- Expand_N_Object_Renaming_Declaration --
62 ------------------------------------------
64 -- Most object renaming cases can be done by just capturing the address
65 -- of the renamed object. The cases in which this is not true are when
66 -- this address is not computable, since it involves extraction of a
67 -- packed array element, or of a record component to which a component
68 -- clause applies (that can specify an arbitrary bit boundary), or where
69 -- the enclosing record itself has a non-standard representation.
71 -- In these two cases, we pre-evaluate the renaming expression, by
72 -- extracting and freezing the values of any subscripts, and then we
73 -- set the flag Is_Renaming_Of_Object which means that any reference
74 -- to the object will be handled by macro substitution in the front
75 -- end, and the back end will know to ignore the renaming declaration.
77 -- An additional odd case that requires processing by expansion is
78 -- the renaming of a discriminant of a mutable record type. The object
79 -- is a constant because it renames something that cannot be assigned to,
80 -- but in fact the underlying value can change and must be reevaluated
81 -- at each reference. Gigi does have a notion of a "constant view" of
82 -- an object, and therefore the front-end must perform the expansion.
83 -- For simplicity, and to bypass some obscure code-generation problem,
84 -- we use macro substitution for all renamed discriminants, whether the
85 -- enclosing type is constrained or not.
87 -- The other special processing required is for the case of renaming
88 -- of an object of a class wide type, where it is necessary to build
89 -- the appropriate subtype for the renamed object.
90 -- More comments needed for this para ???
92 procedure Expand_N_Object_Renaming_Declaration
(N
: Node_Id
) is
93 Nam
: constant Node_Id
:= Name
(N
);
97 procedure Evaluate_Name
(Fname
: Node_Id
);
98 -- A recursive procedure used to freeze a name in the sense described
99 -- above, i.e. any variable references or function calls are removed.
100 -- Of course the outer level variable reference must not be removed.
101 -- For example in A(J,F(K)), A is left as is, but J and F(K) are
102 -- evaluated and removed.
104 function Evaluation_Required
(Nam
: Node_Id
) return Boolean;
105 -- Determines whether it is necessary to do static name evaluation
106 -- for renaming of Nam. It is considered necessary if evaluating the
107 -- name involves indexing a packed array, or extracting a component
108 -- of a record to which a component clause applies. Note that we are
109 -- only interested in these operations if they occur as part of the
110 -- name itself, subscripts are just values that are computed as part
111 -- of the evaluation, so their form is unimportant.
117 procedure Evaluate_Name
(Fname
: Node_Id
) is
118 K
: constant Node_Kind
:= Nkind
(Fname
);
122 -- For an explicit dereference, we simply force the evaluation
123 -- of the name expression. The dereference provides a value that
124 -- is the address for the renamed object, and it is precisely
125 -- this value that we want to preserve.
127 if K
= N_Explicit_Dereference
then
128 Force_Evaluation
(Prefix
(Fname
));
130 -- For a selected component, we simply evaluate the prefix
132 elsif K
= N_Selected_Component
then
133 Evaluate_Name
(Prefix
(Fname
));
135 -- For an indexed component, or an attribute reference, we evaluate
136 -- the prefix, which is itself a name, recursively, and then force
137 -- the evaluation of all the subscripts (or attribute expressions).
139 elsif Nkind_In
(K
, N_Indexed_Component
, N_Attribute_Reference
) then
140 Evaluate_Name
(Prefix
(Fname
));
142 E
:= First
(Expressions
(Fname
));
143 while Present
(E
) loop
144 Force_Evaluation
(E
);
146 if Original_Node
(E
) /= E
then
147 Set_Do_Range_Check
(E
, Do_Range_Check
(Original_Node
(E
)));
153 -- For a slice, we evaluate the prefix, as for the indexed component
154 -- case and then, if there is a range present, either directly or
155 -- as the constraint of a discrete subtype indication, we evaluate
156 -- the two bounds of this range.
158 elsif K
= N_Slice
then
159 Evaluate_Name
(Prefix
(Fname
));
162 DR
: constant Node_Id
:= Discrete_Range
(Fname
);
167 if Nkind
(DR
) = N_Range
then
168 Force_Evaluation
(Low_Bound
(DR
));
169 Force_Evaluation
(High_Bound
(DR
));
171 elsif Nkind
(DR
) = N_Subtype_Indication
then
172 Constr
:= Constraint
(DR
);
174 if Nkind
(Constr
) = N_Range_Constraint
then
175 Rexpr
:= Range_Expression
(Constr
);
177 Force_Evaluation
(Low_Bound
(Rexpr
));
178 Force_Evaluation
(High_Bound
(Rexpr
));
183 -- For a type conversion, the expression of the conversion must be
184 -- the name of an object, and we simply need to evaluate this name.
186 elsif K
= N_Type_Conversion
then
187 Evaluate_Name
(Expression
(Fname
));
189 -- For a function call, we evaluate the call
191 elsif K
= N_Function_Call
then
192 Force_Evaluation
(Fname
);
194 -- The remaining cases are direct name, operator symbol and
195 -- character literal. In all these cases, we do nothing, since
196 -- we want to reevaluate each time the renamed object is used.
203 -------------------------
204 -- Evaluation_Required --
205 -------------------------
207 function Evaluation_Required
(Nam
: Node_Id
) return Boolean is
209 if Nkind_In
(Nam
, N_Indexed_Component
, N_Slice
) then
210 if Is_Packed
(Etype
(Prefix
(Nam
))) then
213 return Evaluation_Required
(Prefix
(Nam
));
216 elsif Nkind
(Nam
) = N_Selected_Component
then
218 Rec_Type
: constant Entity_Id
:= Etype
(Prefix
(Nam
));
221 if Present
(Component_Clause
(Entity
(Selector_Name
(Nam
))))
222 or else Has_Non_Standard_Rep
(Rec_Type
)
226 elsif Ekind
(Entity
(Selector_Name
(Nam
))) = E_Discriminant
227 and then Is_Record_Type
(Rec_Type
)
228 and then not Is_Concurrent_Record_Type
(Rec_Type
)
233 return Evaluation_Required
(Prefix
(Nam
));
240 end Evaluation_Required
;
242 -- Start of processing for Expand_N_Object_Renaming_Declaration
245 -- Perform name evaluation if required
247 if Evaluation_Required
(Nam
) then
249 Set_Is_Renaming_Of_Object
(Defining_Identifier
(N
));
252 -- Deal with construction of subtype in class-wide case
254 T
:= Etype
(Defining_Identifier
(N
));
256 if Is_Class_Wide_Type
(T
) then
257 Expand_Subtype_From_Expr
(N
, T
, Subtype_Mark
(N
), Name
(N
));
258 Find_Type
(Subtype_Mark
(N
));
259 Set_Etype
(Defining_Identifier
(N
), Entity
(Subtype_Mark
(N
)));
261 -- Freeze the class-wide subtype here to ensure that the subtype
262 -- and equivalent type are frozen before the renaming.
264 Freeze_Before
(N
, Entity
(Subtype_Mark
(N
)));
267 -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in-
268 -- place function, then a temporary return object needs to be created
269 -- and access to it must be passed to the function. Currently we limit
270 -- such functions to those with inherently limited result subtypes, but
271 -- eventually we plan to expand the functions that are treated as
272 -- build-in-place to include other composite result types.
274 if Ada_Version
>= Ada_2005
275 and then Is_Build_In_Place_Function_Call
(Nam
)
277 Make_Build_In_Place_Call_In_Anonymous_Context
(Nam
);
280 -- Create renaming entry for debug information
282 Decl
:= Debug_Renaming_Declaration
(N
);
284 if Present
(Decl
) then
285 Insert_Action
(N
, Decl
);
287 end Expand_N_Object_Renaming_Declaration
;
289 -------------------------------------------
290 -- Expand_N_Package_Renaming_Declaration --
291 -------------------------------------------
293 procedure Expand_N_Package_Renaming_Declaration
(N
: Node_Id
) is
294 Decl
: constant Node_Id
:= Debug_Renaming_Declaration
(N
);
297 if Present
(Decl
) then
299 -- If we are in a compilation unit, then this is an outer
300 -- level declaration, and must have a scope of Standard
302 if Nkind
(Parent
(N
)) = N_Compilation_Unit
then
304 Aux
: constant Node_Id
:= Aux_Decls_Node
(Parent
(N
));
307 Push_Scope
(Standard_Standard
);
309 if No
(Actions
(Aux
)) then
310 Set_Actions
(Aux
, New_List
(Decl
));
312 Append
(Decl
, Actions
(Aux
));
317 -- Enter the debug variable in the qualification list, which
318 -- must be done at this point because auxiliary declarations
319 -- occur at the library level and aren't associated with a
322 Qualify_Entity_Names
(Decl
);
327 -- Otherwise, just insert after the package declaration
330 Insert_Action
(N
, Decl
);
333 end Expand_N_Package_Renaming_Declaration
;
335 ----------------------------------------------
336 -- Expand_N_Subprogram_Renaming_Declaration --
337 ----------------------------------------------
339 procedure Expand_N_Subprogram_Renaming_Declaration
(N
: Node_Id
) is
340 Nam
: constant Node_Id
:= Name
(N
);
343 -- When the prefix of the name is a function call, we must force the
344 -- call to be made by removing side effects from the call, since we
345 -- must only call the function once.
347 if Nkind
(Nam
) = N_Selected_Component
348 and then Nkind
(Prefix
(Nam
)) = N_Function_Call
350 Remove_Side_Effects
(Prefix
(Nam
));
352 -- For an explicit dereference, the prefix must be captured to prevent
353 -- reevaluation on calls through the renaming, which could result in
354 -- calling the wrong subprogram if the access value were to be changed.
356 elsif Nkind
(Nam
) = N_Explicit_Dereference
then
357 Force_Evaluation
(Prefix
(Nam
));
360 -- Check whether this is a renaming of a predefined equality on an
361 -- untagged record type (AI05-0123).
363 if Is_Entity_Name
(Nam
)
364 and then Chars
(Entity
(Nam
)) = Name_Op_Eq
365 and then Scope
(Entity
(Nam
)) = Standard_Standard
366 and then Ada_Version
>= Ada_2012
369 Loc
: constant Source_Ptr
:= Sloc
(N
);
370 Id
: constant Entity_Id
:= Defining_Entity
(N
);
371 Typ
: constant Entity_Id
:= Etype
(First_Formal
(Id
));
374 Body_Id
: constant Entity_Id
:=
375 Make_Defining_Identifier
(Sloc
(N
), Chars
(Id
));
378 if Is_Record_Type
(Typ
)
379 and then not Is_Tagged_Type
(Typ
)
380 and then not Is_Frozen
(Typ
)
382 -- Build body for renamed equality, to capture its current
383 -- meaning. It may be redefined later, but the renaming is
384 -- elaborated where it occurs. This is technically known as
385 -- Squirreling semantics. Renaming is rewritten as a subprogram
386 -- declaration, and the body is inserted at the end of the
387 -- current declaration list to prevent premature freezing.
389 Set_Alias
(Id
, Empty
);
390 Set_Has_Completion
(Id
, False);
392 Make_Subprogram_Declaration
(Sloc
(N
),
393 Specification
=> Specification
(N
)));
394 Set_Has_Delayed_Freeze
(Id
);
396 Decl
:= Make_Subprogram_Body
(Loc
,
398 Make_Function_Specification
(Loc
,
399 Defining_Unit_Name
=> Body_Id
,
400 Parameter_Specifications
=>
401 Copy_Parameter_List
(Id
),
403 New_Occurrence_Of
(Standard_Boolean
, Loc
)),
404 Declarations
=> Empty_List
,
405 Handled_Statement_Sequence
=> Empty
);
407 Set_Handled_Statement_Sequence
(Decl
,
408 Make_Handled_Sequence_Of_Statements
(Loc
,
409 Statements
=> New_List
(
410 Make_Simple_Return_Statement
(Loc
,
412 Expand_Record_Equality
416 Make_Identifier
(Loc
, Chars
(First_Formal
(Id
))),
419 (Loc
, Chars
(Next_Formal
(First_Formal
(Id
)))),
420 Bodies
=> Declarations
(Decl
))))));
422 Append
(Decl
, List_Containing
(N
));
423 Set_Debug_Info_Needed
(Body_Id
);
427 end Expand_N_Subprogram_Renaming_Declaration
;