[Ada] Cleanup front end code (introduce N_Subprogram_Call)

Message ID	20120612110930.GA2349@adacore.com
State	New
Headers	show Return-Path: <gcc-patches-return-320701-incoming=patchwork.ozlabs.org@gcc.gnu.org> Comment: DKIM? See http://www.dkim.org Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=yr2SiT4mecOVtbLkoFxGGe4R/xqthMMwxgdSiGWbClykt31Cl78krvhsBsNrHB 7/owwnUCqV6MI6T4EHt5hJyXkJIBwZoBrgRavwDGPQFKOKTBBuMJOPuRsfAX5POZ iCvGeI6iqKywbEoAjzuPcLVTlQIpoM+1/hyHCfCGAVKy0=; Date: Tue, 12 Jun 2012 07:09:31 -0400 From: Arnaud Charlet <charlet@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Robert Dewar <dewar@adacore.com> Subject: [Ada] Cleanup front end code (introduce N_Subprogram_Call) Message-ID: <20120612110930.GA2349@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="u3/rZRmxL6MmkK24" Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org

Index: sem_dist.adb =================================================================== --- sem_dist.adb (revision 188428) +++ sem_dist.adb (working copy) @@ -242,7 +242,7 @@ Par : Node_Id; begin - if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (N) in N_Subprogram_Call and then Nkind (Name (N)) in N_Has_Entity and then Is_Remote_Call_Interface (Entity (Name (N))) and then Has_All_Calls_Remote (Scope (Entity (Name (N)))) Index: exp_ch7.adb =================================================================== --- exp_ch7.adb (revision 188444) +++ exp_ch7.adb (working copy) @@ -4337,32 +4337,14 @@ ---------------------- function Requires_Hooking return Boolean is - function Is_Subprogram_Call (Nod : Node_Id) return Boolean; - -- Determine whether a particular node is a procedure of function - -- call. - - ------------------------ - -- Is_Subprogram_Call -- - ------------------------ - - function Is_Subprogram_Call (Nod : Node_Id) return Boolean is - begin - return - Nkind_In (Nod, N_Function_Call, N_Procedure_Call_Statement); - end Is_Subprogram_Call; - - -- Start of processing for Requires_Hooking - begin -- The context is either a procedure or function call or an object - -- declaration initialized by such a call. In all these cases, the - -- calls are assumed to raise an exception. + -- declaration initialized by a function call. In all these cases, + -- the calls might raise an exception. - return - Is_Subprogram_Call (N) - or else - (Nkind (N) = N_Object_Declaration - and then Is_Subprogram_Call (Expression (N))); + return Nkind (N) in N_Subprogram_Call + or else (Nkind (N) = N_Object_Declaration + and then Nkind (Expression (N)) = N_Function_Call); end Requires_Hooking; -- Local variables Index: sem_type.adb =================================================================== --- sem_type.adb (revision 188428) +++ sem_type.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -481,7 +481,7 @@ then Add_Entry (Entity (N), Etype (N)); - elsif Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) + elsif Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then Add_Entry (Entity (Name (N)), Etype (N)); @@ -1467,9 +1467,7 @@ return It1; else - if Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement - then + if Nkind (N) in N_Subprogram_Call then Act1 := First_Actual (N); if Present (Act1) then @@ -1867,8 +1865,7 @@ elsif In_Instance and then not In_Generic_Actual (N) then - if Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement + if Nkind (N) in N_Subprogram_Call or else (Nkind (N) in N_Has_Entity and then Index: exp_attr.adb =================================================================== --- exp_attr.adb (revision 188428) +++ exp_attr.adb (working copy) @@ -421,7 +421,7 @@ Par := Parent (Par); end if; - if Nkind_In (Par, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (Par) in N_Subprogram_Call and then Is_Entity_Name (Name (Par)) then Subp := Entity (Name (Par)); Index: sinfo.ads =================================================================== --- sinfo.ads (revision 188428) +++ sinfo.ads (working copy) @@ -7649,11 +7649,17 @@ N_Conditional_Expression, N_Explicit_Dereference, N_Expression_With_Actions, + + -- N_Subexpr, N_Has_Etype, N_Subprogram_Call + N_Function_Call, + N_Procedure_Call_Statement, + + -- N_Subexpr, N_Has_Etype + N_Indexed_Component, N_Integer_Literal, N_Null, - N_Procedure_Call_Statement, N_Qualified_Expression, N_Quantified_Expression, @@ -8067,6 +8073,10 @@ -- (since overloading is possible, so it needs to go through the normal -- overloading resolution for expressions). + subtype N_Subprogram_Call is Node_Kind range + N_Function_Call .. + N_Procedure_Call_Statement; + subtype N_Subprogram_Instantiation is Node_Kind range N_Function_Instantiation .. N_Procedure_Instantiation; Index: sem_ch7.adb =================================================================== --- sem_ch7.adb (revision 188441) +++ sem_ch7.adb (working copy) @@ -533,7 +533,7 @@ begin -- Check name of procedure or function calls - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then return Abandon; Index: exp_alfa.adb =================================================================== --- exp_alfa.adb (revision 188428) +++ exp_alfa.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -87,8 +87,7 @@ N_Subprogram_Body => Qualify_Entity_Names (N); - when N_Function_Call | - N_Procedure_Call_Statement => + when N_Subprogram_Call => Expand_Alfa_Call (N); when N_Expanded_Name | Index: sem_scil.adb =================================================================== --- sem_scil.adb (revision 188428) +++ sem_scil.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2012, 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- -- @@ -59,10 +59,7 @@ -- Parent of SCIL dispatching call nodes MUST be a subprogram call - if not Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then - pragma Assert (False); + if Nkind (N) not in N_Subprogram_Call then raise Program_Error; -- In simple cases the controlling tag is the tag of the Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 188443) +++ sem_ch12.adb (working copy) @@ -13578,9 +13578,7 @@ -- information on aggregates in instances. if Nkind (N2) = Nkind (N) - and then - Nkind_In (Parent (N2), N_Procedure_Call_Statement, - N_Function_Call) + and then Nkind (Parent (N2)) in N_Subprogram_Call and then Comes_From_Source (Typ) then if Is_Immediately_Visible (Scope (Typ)) then Index: sem_util.adb =================================================================== --- sem_util.adb (revision 188434) +++ sem_util.adb (working copy) @@ -3747,7 +3747,7 @@ then Call := Parent (Parnt); - elsif Nkind_In (Parnt, N_Procedure_Call_Statement, N_Function_Call) then + elsif Nkind (Parnt) in N_Subprogram_Call then Call := Parnt; else @@ -6604,7 +6604,7 @@ when N_Parameter_Association => return N = Explicit_Actual_Parameter (Parent (N)); - when N_Function_Call | N_Procedure_Call_Statement => + when N_Subprogram_Call => return Is_List_Member (N) and then List_Containing (N) = Parameter_Associations (Parent (N)); @@ -8127,9 +8127,8 @@ function Is_Remote_Call (N : Node_Id) return Boolean is begin - if Nkind (N) /= N_Procedure_Call_Statement - and then Nkind (N) /= N_Function_Call - then + if Nkind (N) not in N_Subprogram_Call then + -- An entry call cannot be remote return False; @@ -9328,9 +9327,8 @@ -- In older versions of Ada function call arguments are never -- lvalues. In Ada 2012 functions can have in-out parameters. - when N_Function_Call | - N_Procedure_Call_Statement | - N_Entry_Call_Statement | + when N_Subprogram_Call | + N_Entry_Call_Statement | N_Accept_Statement => if Nkind (P) = N_Function_Call and then Ada_Version < Ada_2012 then Index: sem_res.adb =================================================================== --- sem_res.adb (revision 188438) +++ sem_res.adb (working copy) @@ -2144,9 +2144,7 @@ -- of the arguments is Any_Type, and if so, suppress -- the message, since it is a cascaded error. - if Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then + if Nkind (N) in N_Subprogram_Call then declare A : Node_Id; E : Node_Id; @@ -2212,8 +2210,7 @@ ("\\possible interpretation#!", N); end if; - if Nkind_In - (N, N_Procedure_Call_Statement, N_Function_Call) + if Nkind (N) in N_Subprogram_Call and then Present (Parameter_Associations (N)) then Report_Ambiguous_Argument; @@ -2360,7 +2357,7 @@ -- For procedure or function calls, set the type of the name, -- and also the entity pointer for the prefix. - elsif Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) + elsif Nkind (N) in N_Subprogram_Call and then Is_Entity_Name (Name (N)) then Set_Etype (Name (N), Expr_Type); @@ -2990,8 +2987,7 @@ if not Warn_On_Parameter_Order or else No (Parameter_Associations (N)) - or else not Nkind_In (Original_Node (N), N_Procedure_Call_Statement, - N_Function_Call) + or else Nkind (Original_Node (N)) not in N_Subprogram_Call or else not Comes_From_Source (N) then return; @@ -4223,11 +4219,9 @@ Par : constant Node_Id := Parent (N); begin - return - Nkind_In (Par, N_Function_Call, - N_Procedure_Call_Statement) - and then Is_Entity_Name (Name (Par)) - and then Is_Dispatching_Operation (Entity (Name (Par))); + return Nkind (Par) in N_Subprogram_Call + and then Is_Entity_Name (Name (Par)) + and then Is_Dispatching_Operation (Entity (Name (Par))); end In_Dispatching_Context; -- Start of processing for Resolve_Allocator @@ -7749,9 +7743,7 @@ -- In the common case of a call which uses an explicitly null value -- for an access parameter, give specialized error message. - if Nkind_In (Parent (N), N_Procedure_Call_Statement, - N_Function_Call) - then + if Nkind (Parent (N)) in N_Subprogram_Call then Error_Msg_N ("null is not allowed as argument for an access parameter", N); Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 188428) +++ sem_attr.adb (working copy) @@ -3849,8 +3849,7 @@ -- Case of attribute used as actual for subprogram (positional) - elsif Nkind_In (Parnt, N_Procedure_Call_Statement, - N_Function_Call) + elsif Nkind (Parnt) in N_Subprogram_Call and then Is_Entity_Name (Name (Parnt)) then Must_Be_Imported (Entity (Name (Parnt))); @@ -3858,8 +3857,7 @@ -- Case of attribute used as actual for subprogram (named) elsif Nkind (Parnt) = N_Parameter_Association - and then Nkind_In (GParnt, N_Procedure_Call_Statement, - N_Function_Call) + and then Nkind (GParnt) in N_Subprogram_Call and then Is_Entity_Name (Name (GParnt)) then Must_Be_Imported (Entity (Name (GParnt))); Index: sem_elab.adb =================================================================== --- sem_elab.adb (revision 188428) +++ sem_elab.adb (working copy) @@ -545,8 +545,7 @@ -- If the call is known to be within a local Suppress Elaboration -- pragma, nothing to check. This can happen in task bodies. - if (Nkind (N) = N_Function_Call - or else Nkind (N) = N_Procedure_Call_Statement) + if Nkind (N) in N_Subprogram_Call and then No_Elaboration_Check (N) then return; @@ -990,9 +989,7 @@ -- which can happen if the body enclosing the call appears -- itself in a call whose elaboration check is delayed. - if Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement) - then + if Nkind (N) in N_Subprogram_Call then Set_No_Elaboration_Check (N); end if; end if; @@ -1184,8 +1181,7 @@ -- Nothing to do if this is not a call or attribute reference (happens -- in some error conditions, and in some cases where rewriting occurs). - elsif Nkind (N) /= N_Function_Call - and then Nkind (N) /= N_Procedure_Call_Statement + elsif Nkind (N) not in N_Subprogram_Call and then Nkind (N) /= N_Attribute_Reference then return; @@ -1510,8 +1506,7 @@ Func : Entity_Id; begin - if (Nkind (Nod) = N_Function_Call - or else Nkind (Nod) = N_Procedure_Call_Statement) + if Nkind (Nod) in N_Subprogram_Call and then Is_Entity_Name (Name (Nod)) then Func := Entity (Name (Nod)); Index: exp_ch6.adb =================================================================== --- exp_ch6.adb (revision 188428) +++ exp_ch6.adb (working copy) @@ -3271,7 +3271,7 @@ -- Ada 2005 (AI-251): If some formal is a class-wide interface, expand -- it to point to the correct secondary virtual table - if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (Call_Node) in N_Subprogram_Call and then CW_Interface_Formals_Present then Expand_Interface_Actuals (Call_Node); @@ -3285,7 +3285,7 @@ -- back-ends directly handle the generation of dispatching calls and -- would have to undo any expansion to an indirect call. - if Nkind_In (Call_Node, N_Function_Call, N_Procedure_Call_Statement) + if Nkind (Call_Node) in N_Subprogram_Call and then Present (Controlling_Argument (Call_Node)) then declare @@ -3868,13 +3868,14 @@ -- intermediate result after its use. elsif Is_Build_In_Place_Function_Call (Call_Node) - and then Nkind_In (Parent (Call_Node), N_Attribute_Reference, - N_Function_Call, - N_Indexed_Component, - N_Object_Renaming_Declaration, - N_Procedure_Call_Statement, - N_Selected_Component, - N_Slice) + and then + Nkind_In (Parent (Call_Node), N_Attribute_Reference, + N_Function_Call, + N_Indexed_Component, + N_Object_Renaming_Declaration, + N_Procedure_Call_Statement, + N_Selected_Component, + N_Slice) then Establish_Transient_Scope (Call_Node, Sec_Stack => True); end if; Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 188441) +++ sem_ch4.adb (working copy) @@ -2299,7 +2299,7 @@ Analyze (P); - if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then + if Nkind (N) in N_Subprogram_Call then -- If P is an explicit dereference whose prefix is of a -- remote access-to-subprogram type, then N has already @@ -6736,9 +6736,7 @@ (N : Node_Id; CW_Test_Only : Boolean := False) return Boolean is K : constant Node_Kind := Nkind (Parent (N)); - Is_Subprg_Call : constant Boolean := Nkind_In - (K, N_Procedure_Call_Statement, - N_Function_Call); + Is_Subprg_Call : constant Boolean := K in N_Subprogram_Call; Loc : constant Source_Ptr := Sloc (N); Obj : constant Node_Id := Prefix (N); @@ -7087,8 +7085,7 @@ -- Common case covering 1) Call to a procedure and 2) Call to a -- function that has some additional actuals. - if Nkind_In (Parent_Node, N_Function_Call, - N_Procedure_Call_Statement) + if Nkind (Parent_Node) in N_Subprogram_Call -- N is a selected component node containing the name of the -- subprogram. If N is not the name of the parent node we must Index: sem_warn.adb =================================================================== --- sem_warn.adb (revision 188428) +++ sem_warn.adb (working copy) @@ -511,9 +511,8 @@ -- Call to subprogram - elsif Nkind (N) = N_Procedure_Call_Statement - or else Nkind (N) = N_Function_Call - then + elsif Nkind (N) in N_Subprogram_Call then + -- If subprogram is within the scope of the entity we are dealing -- with as the loop variable, then it could modify this parameter, -- so we abandon in this case. In the case of a subprogram that is @@ -3282,7 +3281,7 @@ -- Exclude calls rewritten as enumeration literals - if not Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then + if Nkind (N) not in N_Subprogram_Call then return; end if; Index: scil_ll.adb =================================================================== --- scil_ll.adb (revision 188428) +++ scil_ll.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2012, 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- -- @@ -117,8 +117,7 @@ null; when N_SCIL_Dispatching_Call => - pragma Assert (Nkind_In (N, N_Function_Call, - N_Procedure_Call_Statement)); + pragma Assert (Nkind (N) in N_Subprogram_Call); null; when N_SCIL_Membership_Test => Index: exp_cg.adb =================================================================== --- exp_cg.adb (revision 188428) +++ exp_cg.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2012, 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- -- @@ -122,7 +122,7 @@ for J in Call_Graph_Nodes.First .. Call_Graph_Nodes.Last loop N := Call_Graph_Nodes.Table (J); - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then + if Nkind (N) in N_Subprogram_Call then Write_Call_Info (N); else pragma Assert (Nkind (N) = N_Defining_Identifier); @@ -349,7 +349,7 @@ procedure Register_CG_Node (N : Node_Id) is begin - if Nkind_In (N, N_Procedure_Call_Statement, N_Function_Call) then + if Nkind (N) in N_Subprogram_Call then if Current_Scope = Main_Unit_Entity or else Entity_Is_In_Main_Unit (Current_Scope) then

[Ada] Cleanup front end code (introduce N_Subprogram_Call)

Commit Message

Patch