From patchwork Mon Oct 19 09:54:23 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1384167 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4CFBwc5zMXz9sSG for ; Mon, 19 Oct 2020 20:56:16 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6F1273887033; Mon, 19 Oct 2020 09:54:39 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 464413870874 for ; Mon, 19 Oct 2020 09:54:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 464413870874 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3E1AB117D1F; Mon, 19 Oct 2020 05:54:23 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id uq00livROb6s; Mon, 19 Oct 2020 05:54:23 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 0D5D8117DE6; Mon, 19 Oct 2020 05:54:23 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 0C39611E; Mon, 19 Oct 2020 05:54:23 -0400 (EDT) Date: Mon, 19 Oct 2020 05:54:23 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Subject: [Ada] Ada_2020: Implement Key_Expression for named container aggregates Message-ID: <20201019095422.GA91272@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-9.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, JMQ_SPF_NEUTRAL, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ed Schonberg Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" This patch implements the Key_Expression mechanism for container aggregates. A Key_Expression specifies a mapping between the loop variable in an iterated element association, and the value of the key to be used for insertion of successive components into the container being populated. The parser creates an Iterated_Element_Association only when the key_expression appears, as indicated by the presence of a "use" keyword. If the key_expression is not present, the parser generates an Iterated_Component_Association. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * par-ch4.adb: (P_Aggregate_Or_Paren_Expr): Recognize Iterated_Element_Component. (P_Iterated_Component_Association): Rebuild node as an Iterated_ Element_Association when Key_Expression is present, and attach either the Loop_Parameter_Specification or the Iterator_Specification to the new node. * sem_aggr.adb: (Resolve_Container_Aggregate): Resolve_Iterated_Association handles bota Iterated_Component_ and Iterated_Element_Associations, in which case it analyzes and resoles the orresponding Key_Expression. * exp_aggr.adb (Expand_Iterated_Component): If a Key_Expression is present, use it as the required parameter in the call to the insertion routine for the destination container aggregate. Call this routine for both kinds of Iterated_Associations. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6899,23 +6899,62 @@ package body Exp_Aggr is procedure Expand_Iterated_Component (Comp : Node_Id) is Expr : constant Node_Id := Expression (Comp); - Loop_Id : constant Entity_Id := - Make_Defining_Identifier (Loc, - Chars => Chars (Defining_Identifier (Comp))); + Key_Expr : Node_Id := Empty; + Loop_Id : Entity_Id; L_Range : Node_Id; L_Iteration_Scheme : Node_Id; Loop_Stat : Node_Id; Stats : List_Id; begin - if Present (Iterator_Specification (Comp)) then + if Nkind (Comp) = N_Iterated_Element_Association then + Key_Expr := Key_Expression (Comp); + + -- We create a new entity as loop identifier in all cases, + -- as is done for generated loops elsewhere, as the loop + -- structure has been previously analyzed. + + if Present (Iterator_Specification (Comp)) then + + -- Either an Iterator_Specification of a Loop_Parameter_ + -- Specification is present. + + L_Iteration_Scheme := + Make_Iteration_Scheme (Loc, + Iterator_Specification => Iterator_Specification (Comp)); + Loop_Id := + Make_Defining_Identifier (Loc, + Chars => Chars (Defining_Identifier + (Iterator_Specification (Comp)))); + Set_Defining_Identifier + (Iterator_Specification (L_Iteration_Scheme), Loop_Id); + + else + L_Iteration_Scheme := + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Loop_Parameter_Specification (Comp)); + Loop_Id := + Make_Defining_Identifier (Loc, + Chars => Chars (Defining_Identifier + (Loop_Parameter_Specification (Comp)))); + Set_Defining_Identifier + (Loop_Parameter_Specification + (L_Iteration_Scheme), Loop_Id); + end if; + + elsif Present (Iterator_Specification (Comp)) then L_Iteration_Scheme := Make_Iteration_Scheme (Loc, Iterator_Specification => Iterator_Specification (Comp)); else L_Range := Relocate_Node (First (Discrete_Choices (Comp))); + Loop_Id := + Make_Defining_Identifier (Loc, + Chars => Chars (Defining_Identifier (Comp))); + L_Iteration_Scheme := Make_Iteration_Scheme (Loc, Loop_Parameter_Specification => @@ -6928,6 +6967,9 @@ package body Exp_Aggr is -- expression is needed. For a named aggregate, the loop variable, -- whose type is that of the key, is an additional parameter for -- the insertion operation. + -- If a Key_Expression is present, it serves as the additional + -- parameter. Otherwise the key is given by the loop parameter + -- itself. if Present (Add_Unnamed_Subp) then Stats := New_List @@ -6937,13 +6979,27 @@ package body Exp_Aggr is New_List (New_Occurrence_Of (Temp, Loc), New_Copy_Tree (Expr)))); else - Stats := New_List - (Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc), - Parameter_Associations => - New_List (New_Occurrence_Of (Temp, Loc), - New_Occurrence_Of (Loop_Id, Loc), - New_Copy_Tree (Expr)))); + -- Named or indexed aggregate, for which a key is present, + -- possibly with a specified key_expression. + + if Present (Key_Expr) then + Stats := New_List + (Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Temp, Loc), + New_Copy_Tree (Key_Expr), + New_Copy_Tree (Expr)))); + + else + Stats := New_List + (Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Temp, Loc), + New_Occurrence_Of (Loop_Id, Loc), + New_Copy_Tree (Expr)))); + end if; end if; Loop_Stat := Make_Implicit_Loop_Statement @@ -7029,7 +7085,9 @@ package body Exp_Aggr is -- generate an insertion statement for each. while Present (Comp) loop - if Nkind (Comp) = N_Iterated_Component_Association then + if Nkind (Comp) in N_Iterated_Component_Association + | N_Iterated_Element_Association + then Expand_Iterated_Component (Comp); else Key := First (Choices (Comp)); diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -1607,8 +1607,11 @@ package body Ch4 is -- identifier or OTHERS follows (the latter cases are missing -- comma cases). Also assume positional if a semicolon follows, -- which can happen if there are missing parens. + -- In Ada_2012 and Ada_2020 an iterated association can appear. - elsif Nkind (Expr_Node) = N_Iterated_Component_Association then + elsif Nkind (Expr_Node) in + N_Iterated_Component_Association | N_Iterated_Element_Association + then if No (Assoc_List) then Assoc_List := New_List (Expr_Node); else @@ -3417,6 +3420,7 @@ package body Ch4 is function P_Iterated_Component_Association return Node_Id is Assoc_Node : Node_Id; + Choice : Node_Id; Id : Node_Id; Iter_Spec : Node_Id; Loop_Spec : Node_Id; @@ -3451,15 +3455,25 @@ package body Ch4 is if Token = Tok_Use then - -- Key-expression is present, rewrite node as an + -- Ada_2020 Key-expression is present, rewrite node as an -- iterated_Element_Awwoiation. Scan; -- past USE Loop_Spec := New_Node (N_Loop_Parameter_Specification, Prev_Token_Ptr); Set_Defining_Identifier (Loop_Spec, Id); - Set_Discrete_Subtype_Definition (Loop_Spec, - First (Discrete_Choices (Assoc_Node))); + + Choice := First (Discrete_Choices (Assoc_Node)); + + if Present (Next (Choice)) then + Error_Msg_N ("expect loop parameter specification", Choice); + end if; + + Remove (Choice); + Set_Discrete_Subtype_Definition (Loop_Spec, Choice); + + Assoc_Node := + New_Node (N_Iterated_Element_Association, Prev_Token_Ptr); Set_Loop_Parameter_Specification (Assoc_Node, Loop_Spec); Set_Key_Expression (Assoc_Node, P_Expression); end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -48,6 +48,7 @@ with Sem; use Sem; with Sem_Aux; use Sem_Aux; with Sem_Cat; use Sem_Cat; with Sem_Ch3; use Sem_Ch3; +with Sem_Ch5; use Sem_Ch5; with Sem_Ch8; use Sem_Ch8; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; @@ -2646,11 +2647,12 @@ package body Sem_Aggr is --------------------------------- procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is - procedure Resolve_Iterated_Component_Association + procedure Resolve_Iterated_Association (Comp : Node_Id; Key_Type : Entity_Id; Elmt_Type : Entity_Id); - -- Resolve choices and expression in an iterated component association. + -- Resolve choices and expression in an iterated component association + -- or an iterated element association, which has a key_expression. -- This is similar but not identical to the handling of this construct -- in an array aggregate. -- For a named container, the type of each choice must be compatible @@ -2666,25 +2668,54 @@ package body Sem_Aggr is New_Indexed_Subp : Node_Id := Empty; Assign_Indexed_Subp : Node_Id := Empty; - -------------------------------------------- - -- Resolve_Iterated_Component_Association -- - -------------------------------------------- + ---------------------------------- + -- Resolve_Iterated_Association -- + ---------------------------------- - procedure Resolve_Iterated_Component_Association + procedure Resolve_Iterated_Association (Comp : Node_Id; Key_Type : Entity_Id; Elmt_Type : Entity_Id) is - Choice : Node_Id; - Ent : Entity_Id; - Expr : Node_Id; - Id : Entity_Id; - Iter : Node_Id; - Typ : Entity_Id := Empty; + Choice : Node_Id; + Ent : Entity_Id; + Expr : Node_Id; + Key_Expr : Node_Id; + Id : Entity_Id; + Id_Name : Name_Id; + Iter : Node_Id; + Typ : Entity_Id := Empty; begin - if Present (Iterator_Specification (Comp)) then - Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); + -- If this is an Iterated_Element_Association then either a + -- an Iterator_Specification or a Loop_Parameter specification + -- is present. In both cases a Key_Expression is present. + + if Nkind (Comp) = N_Iterated_Element_Association then + if Present (Loop_Parameter_Specification (Comp)) then + Analyze_Loop_Parameter_Specification + (Loop_Parameter_Specification (Comp)); + Id_Name := Chars (Defining_Identifier + (Loop_Parameter_Specification (Comp))); + else + Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); + Analyze (Iter); + Typ := Etype (Defining_Identifier (Iter)); + Id_Name := Chars (Defining_Identifier + (Iterator_Specification (Comp))); + end if; + + -- Key expression must have the type of the key. We analyze + -- a copy of the original expression, because it will be + -- reanalyzed and copied as needed during expansion of the + -- corresponding loop. + + Key_Expr := Key_Expression (Comp); + Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type); + + elsif Present (Iterator_Specification (Comp)) then + Iter := Copy_Separate_Tree (Iterator_Specification (Comp)); + Id_Name := Chars (Defining_Identifier (Comp)); Analyze (Iter); Typ := Etype (Defining_Identifier (Iter)); @@ -2711,19 +2742,19 @@ package body Sem_Aggr is Next (Choice); end loop; + + Id_Name := Chars (Defining_Identifier (Comp)); end if; -- Create a scope in which to introduce an index, which is usually -- visible in the expression for the component, and needed for its -- analysis. + Id := Make_Defining_Identifier (Sloc (Comp), Id_Name); Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L'); Set_Etype (Ent, Standard_Void_Type); Set_Parent (Ent, Parent (Comp)); Push_Scope (Ent); - Id := - Make_Defining_Identifier (Sloc (Comp), - Chars => Chars (Defining_Identifier (Comp))); -- Insert and decorate the loop variable in the current scope. -- The expression has to be analyzed once the loop variable is @@ -2752,7 +2783,8 @@ package body Sem_Aggr is Expr := New_Copy_Tree (Expression (Comp)); Preanalyze_And_Resolve (Expr, Elmt_Type); End_Scope; - end Resolve_Iterated_Component_Association; + + end Resolve_Iterated_Association; begin pragma Assert (Nkind (Asp) = N_Aggregate); @@ -2797,7 +2829,7 @@ package body Sem_Aggr is & "for unnamed container aggregate", Comp); return; else - Resolve_Iterated_Component_Association + Resolve_Iterated_Association (Comp, Empty, Elmt_Type); end if; @@ -2837,8 +2869,11 @@ package body Sem_Aggr is Analyze_And_Resolve (Expression (Comp), Elmt_Type); - elsif Nkind (Comp) = N_Iterated_Component_Association then - Resolve_Iterated_Component_Association + elsif Nkind (Comp) in + N_Iterated_Component_Association | + N_Iterated_Element_Association + then + Resolve_Iterated_Association (Comp, Key_Type, Elmt_Type); end if; @@ -2883,8 +2918,11 @@ package body Sem_Aggr is Analyze_And_Resolve (Expression (Comp), Comp_Type); - elsif Nkind (Comp) = N_Iterated_Component_Association then - Resolve_Iterated_Component_Association + elsif Nkind (Comp) in + N_Iterated_Component_Association | + N_Iterated_Element_Association + then + Resolve_Iterated_Association (Comp, Index_Type, Comp_Type); end if;