------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- E X P _ C H 8 -- -- -- -- B o d y -- -- -- -- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Atree; use Atree; with Einfo; use Einfo; with Exp_Ch4; use Exp_Ch4; with Exp_Ch6; use Exp_Ch6; with Exp_Dbug; use Exp_Dbug; with Exp_Util; use Exp_Util; with Freeze; use Freeze; with Ghost; use Ghost; with Namet; use Namet; with Nmake; use Nmake; with Nlists; use Nlists; with Opt; use Opt; with Sem; use Sem; with Sem_Ch8; use Sem_Ch8; with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with Stand; use Stand; with Tbuild; use Tbuild; package body Exp_Ch8 is --------------------------------------------- -- Expand_N_Exception_Renaming_Declaration -- --------------------------------------------- procedure Expand_N_Exception_Renaming_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; Decl : Node_Id; begin -- The exception renaming declaration may be subject to pragma Ghost -- with policy Ignore. Set the mode now to ensure that any nodes -- generated during expansion are properly flagged as ignored Ghost. Set_Ghost_Mode (N); Decl := Debug_Renaming_Declaration (N); if Present (Decl) then Insert_Action (N, Decl); end if; -- Restore the original Ghost mode once analysis and expansion have -- taken place. Ghost_Mode := GM; end Expand_N_Exception_Renaming_Declaration; ------------------------------------------ -- Expand_N_Object_Renaming_Declaration -- ------------------------------------------ -- Most object renaming cases can be done by just capturing the address -- of the renamed object. The cases in which this is not true are when -- this address is not computable, since it involves extraction of a -- packed array element, or of a record component to which a component -- clause applies (that can specify an arbitrary bit boundary), or where -- the enclosing record itself has a non-standard representation. -- In these two cases, we pre-evaluate the renaming expression, by -- extracting and freezing the values of any subscripts, and then we -- set the flag Is_Renaming_Of_Object which means that any reference -- to the object will be handled by macro substitution in the front -- end, and the back end will know to ignore the renaming declaration. -- An additional odd case that requires processing by expansion is -- the renaming of a discriminant of a mutable record type. The object -- is a constant because it renames something that cannot be assigned to, -- but in fact the underlying value can change and must be reevaluated -- at each reference. Gigi does have a notion of a "constant view" of -- an object, and therefore the front-end must perform the expansion. -- For simplicity, and to bypass some obscure code-generation problem, -- we use macro substitution for all renamed discriminants, whether the -- enclosing type is constrained or not. -- The other special processing required is for the case of renaming -- of an object of a class wide type, where it is necessary to build -- the appropriate subtype for the renamed object. -- More comments needed for this para ??? procedure Expand_N_Object_Renaming_Declaration (N : Node_Id) is Nam : constant Node_Id := Name (N); Decl : Node_Id; T : Entity_Id; function Evaluation_Required (Nam : Node_Id) return Boolean; -- Determines whether it is necessary to do static name evaluation for -- renaming of Nam. It is considered necessary if evaluating the name -- involves indexing a packed array, or extracting a component of a -- record to which a component clause applies. Note that we are only -- interested in these operations if they occur as part of the name -- itself, subscripts are just values that are computed as part of the -- evaluation, so their form is unimportant. ------------------------- -- Evaluation_Required -- ------------------------- function Evaluation_Required (Nam : Node_Id) return Boolean is begin if Nkind_In (Nam, N_Indexed_Component, N_Slice) then if Is_Packed (Etype (Prefix (Nam))) then return True; else return Evaluation_Required (Prefix (Nam)); end if; elsif Nkind (Nam) = N_Selected_Component then declare Rec_Type : constant Entity_Id := Etype (Prefix (Nam)); begin if Present (Component_Clause (Entity (Selector_Name (Nam)))) or else Has_Non_Standard_Rep (Rec_Type) then return True; elsif Ekind (Entity (Selector_Name (Nam))) = E_Discriminant and then Is_Record_Type (Rec_Type) and then not Is_Concurrent_Record_Type (Rec_Type) then return True; else return Evaluation_Required (Prefix (Nam)); end if; end; else return False; end if; end Evaluation_Required; -- Local variables GM : constant Ghost_Mode_Type := Ghost_Mode; -- Start of processing for Expand_N_Object_Renaming_Declaration begin -- The object renaming declaration may be subject to pragma Ghost with -- policy Ignore. Set the mode now to ensure that any nodes generated -- during expansion are properly flagged as ignored Ghost. Set_Ghost_Mode (N); -- Perform name evaluation if required if Evaluation_Required (Nam) then Evaluate_Name (Nam); Set_Is_Renaming_Of_Object (Defining_Identifier (N)); end if; -- Deal with construction of subtype in class-wide case T := Etype (Defining_Identifier (N)); if Is_Class_Wide_Type (T) then Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N)); Find_Type (Subtype_Mark (N)); Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N))); -- Freeze the class-wide subtype here to ensure that the subtype -- and equivalent type are frozen before the renaming. Freeze_Before (N, Entity (Subtype_Mark (N))); end if; -- Ada 2005 (AI-318-02): If the renamed object is a call to a build-in- -- place function, then a temporary return object needs to be created -- and access to it must be passed to the function. Currently we limit -- such functions to those with inherently limited result subtypes, but -- eventually we plan to expand the functions that are treated as -- build-in-place to include other composite result types. if Ada_Version >= Ada_2005 and then Is_Build_In_Place_Function_Call (Nam) then Make_Build_In_Place_Call_In_Anonymous_Context (Nam); end if; -- Create renaming entry for debug information Decl := Debug_Renaming_Declaration (N); if Present (Decl) then Insert_Action (N, Decl); end if; -- Restore the original Ghost mode once analysis and expansion have -- taken place. Ghost_Mode := GM; end Expand_N_Object_Renaming_Declaration; ------------------------------------------- -- Expand_N_Package_Renaming_Declaration -- ------------------------------------------- procedure Expand_N_Package_Renaming_Declaration (N : Node_Id) is GM : constant Ghost_Mode_Type := Ghost_Mode; Decl : Node_Id; begin -- The package renaming declaration may be subject to pragma Ghost with -- policy Ignore. Set the mode now to ensure that any nodes generated -- during expansion are properly flagged as ignored Ghost. Set_Ghost_Mode (N); Decl := Debug_Renaming_Declaration (N); if Present (Decl) then -- If we are in a compilation unit, then this is an outer -- level declaration, and must have a scope of Standard if Nkind (Parent (N)) = N_Compilation_Unit then declare Aux : constant Node_Id := Aux_Decls_Node (Parent (N)); begin Push_Scope (Standard_Standard); if No (Actions (Aux)) then Set_Actions (Aux, New_List (Decl)); else Append (Decl, Actions (Aux)); end if; Analyze (Decl); -- Enter the debug variable in the qualification list, which -- must be done at this point because auxiliary declarations -- occur at the library level and aren't associated with a -- normal scope. Qualify_Entity_Names (Decl); Pop_Scope; end; -- Otherwise, just insert after the package declaration else Insert_Action (N, Decl); end if; end if; -- Restore the original Ghost mode once analysis and expansion have -- taken place. Ghost_Mode := GM; end Expand_N_Package_Renaming_Declaration; ---------------------------------------------- -- Expand_N_Subprogram_Renaming_Declaration -- ---------------------------------------------- procedure Expand_N_Subprogram_Renaming_Declaration (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); Id : constant Entity_Id := Defining_Entity (N); function Build_Body_For_Renaming return Node_Id; -- Build and return the body for the renaming declaration of an equality -- or inequality operator. ----------------------------- -- Build_Body_For_Renaming -- ----------------------------- function Build_Body_For_Renaming return Node_Id is Body_Id : Entity_Id; Decl : Node_Id; begin Set_Alias (Id, Empty); Set_Has_Completion (Id, False); Rewrite (N, Make_Subprogram_Declaration (Sloc (N), Specification => Specification (N))); Set_Has_Delayed_Freeze (Id); Body_Id := Make_Defining_Identifier (Sloc (N), Chars (Id)); Set_Debug_Info_Needed (Body_Id); Decl := Make_Subprogram_Body (Loc, Specification => Make_Function_Specification (Loc, Defining_Unit_Name => Body_Id, Parameter_Specifications => Copy_Parameter_List (Id), Result_Definition => New_Occurrence_Of (Standard_Boolean, Loc)), Declarations => Empty_List, Handled_Statement_Sequence => Empty); return Decl; end Build_Body_For_Renaming; -- Local variables GM : constant Ghost_Mode_Type := Ghost_Mode; Nam : constant Node_Id := Name (N); -- Start of processing for Expand_N_Subprogram_Renaming_Declaration begin -- The subprogram renaming declaration may be subject to pragma Ghost -- with policy Ignore. Set the mode now to ensure that any nodes created -- during expansion are properly flagged as ignored Ghost. Set_Ghost_Mode (N); -- When the prefix of the name is a function call, we must force the -- call to be made by removing side effects from the call, since we -- must only call the function once. if Nkind (Nam) = N_Selected_Component and then Nkind (Prefix (Nam)) = N_Function_Call then Remove_Side_Effects (Prefix (Nam)); -- For an explicit dereference, the prefix must be captured to prevent -- reevaluation on calls through the renaming, which could result in -- calling the wrong subprogram if the access value were to be changed. elsif Nkind (Nam) = N_Explicit_Dereference then Force_Evaluation (Prefix (Nam)); end if; -- Handle cases where we build a body for a renamed equality if Is_Entity_Name (Nam) and then Chars (Entity (Nam)) = Name_Op_Eq and then Scope (Entity (Nam)) = Standard_Standard then declare Left : constant Entity_Id := First_Formal (Id); Right : constant Entity_Id := Next_Formal (Left); Typ : constant Entity_Id := Etype (Left); Decl : Node_Id; begin -- Check whether this is a renaming of a predefined equality on an -- untagged record type (AI05-0123). if Ada_Version >= Ada_2012 and then Is_Record_Type (Typ) and then not Is_Tagged_Type (Typ) and then not Is_Frozen (Typ) then -- Build body for renamed equality, to capture its current -- meaning. It may be redefined later, but the renaming is -- elaborated where it occurs. This is technically known as -- Squirreling semantics. Renaming is rewritten as a subprogram -- declaration, and the generated body is inserted into the -- freeze actions for the subprogram. Decl := Build_Body_For_Renaming; Set_Handled_Statement_Sequence (Decl, Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( Make_Simple_Return_Statement (Loc, Expression => Expand_Record_Equality (Id, Typ => Typ, Lhs => Make_Identifier (Loc, Chars (Left)), Rhs => Make_Identifier (Loc, Chars (Right)), Bodies => Declarations (Decl)))))); Append_Freeze_Action (Id, Decl); end if; end; end if; -- Restore the original Ghost mode once analysis and expansion have -- taken place. Ghost_Mode := GM; end Expand_N_Subprogram_Renaming_Declaration; end Exp_Ch8;