diff options
author | Ed Schonberg <schonberg@adacore.com> | 2020-07-10 11:13:57 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-19 05:53:41 -0400 |
commit | c0bab60bb9d6f56eedc95f77af3d1057b7fff3bb (patch) | |
tree | dab3252a76f14c20c02575c14109ad6d8e477610 /gcc | |
parent | 86b3d0d55f947d8c5328a25b113bb52ae3ac89fa (diff) | |
download | gcc-c0bab60bb9d6f56eedc95f77af3d1057b7fff3bb.zip gcc-c0bab60bb9d6f56eedc95f77af3d1057b7fff3bb.tar.gz gcc-c0bab60bb9d6f56eedc95f77af3d1057b7fff3bb.tar.bz2 |
[Ada] Ada_2020: Implement Key_Expression for named container aggregates
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/exp_aggr.adb | 82 | ||||
-rw-r--r-- | gcc/ada/par-ch4.adb | 22 | ||||
-rw-r--r-- | gcc/ada/sem_aggr.adb | 84 |
3 files changed, 149 insertions, 39 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index ea95cb6..01e5c83 100644 --- 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 index 649c88e..501429d 100644 --- 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 index 1ada4f6..eb69561 100644 --- 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; |