From 57d62f0cb7346e2a76e7e70c3b3726d0140ec662 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 22 Oct 2010 11:36:41 +0200 Subject: [PATCH] [multiple changes] 2010-10-22 Robert Dewar * sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb (Is_Generic_Formal): Moved from Sem_Util to Sem_Aux. 2010-10-22 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop): New subprogram, implements new iterator forms over arrays and containers, in loops and quantified expressions. * exp_util.adb (Insert_Actions): include N_Iterator_Specification. * par-ch4.adb (P_Quantified_Expression): Handle iterator specifications. * par-ch5.adb (P_Iterator_Specification): New subprogram. Modify P_Iteration_Scheme to handle both loop forms. * sem.adb: Handle N_Iterator_Specification. * sem_ch5.adb, sem_ch5.ads (Analyze_Iterator_Specification): New subprogram. * sinfo.adb, sinfo.ads: New node N_Iterator_Specification. N_Iteration_Scheme can now include an Iterator_Specification. Ditto for N_Quantified_Expression. * snames.ads-tmpl: Add names Cursor, Element, Element_Type, No_Element, and Previous, to support iterators over predefined containers. * sprint.adb: Handle N_Iterator_Specification. From-SVN: r165811 --- gcc/ada/ChangeLog | 24 +++++ gcc/ada/exp_ch5.adb | 207 +++++++++++++++++++++++++++++++++++++++- gcc/ada/exp_util.adb | 1 + gcc/ada/par-ch4.adb | 11 ++- gcc/ada/par-ch5.adb | 69 +++++++++++++- gcc/ada/sem.adb | 3 + gcc/ada/sem_aux.adb | 19 ++++ gcc/ada/sem_aux.ads | 5 + gcc/ada/sem_ch5.adb | 99 +++++++++++++++++++ gcc/ada/sem_ch5.ads | 1 + gcc/ada/sem_util.adb | 19 ---- gcc/ada/sem_util.ads | 5 - gcc/ada/sinfo.adb | 42 ++++++++ gcc/ada/sinfo.ads | 52 +++++++++- gcc/ada/snames.ads-tmpl | 8 ++ gcc/ada/sprint.adb | 27 +++++- 16 files changed, 557 insertions(+), 35 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ffaef4e72ec..04e8a0ec7bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2010-10-22 Robert Dewar + + * sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb + (Is_Generic_Formal): Moved from Sem_Util to Sem_Aux. + +2010-10-22 Ed Schonberg + + * exp_ch5.adb (Expand_Iterator_Loop): New subprogram, implements new + iterator forms over arrays and containers, in loops and quantified + expressions. + * exp_util.adb (Insert_Actions): include N_Iterator_Specification. + * par-ch4.adb (P_Quantified_Expression): Handle iterator specifications. + * par-ch5.adb (P_Iterator_Specification): New subprogram. Modify + P_Iteration_Scheme to handle both loop forms. + * sem.adb: Handle N_Iterator_Specification. + * sem_ch5.adb, sem_ch5.ads (Analyze_Iterator_Specification): New + subprogram. + * sinfo.adb, sinfo.ads: New node N_Iterator_Specification. + N_Iteration_Scheme can now include an Iterator_Specification. Ditto + for N_Quantified_Expression. + * snames.ads-tmpl: Add names Cursor, Element, Element_Type, No_Element, + and Previous, to support iterators over predefined containers. + * sprint.adb: Handle N_Iterator_Specification. + 2010-10-22 Thomas Quinot * sem_prag.adb, sem_ch12.adb, sem_util.adb, sem_util.ads diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 6694fdfbfd4..48e6238fac7 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -103,6 +103,10 @@ package body Exp_Ch5 is -- clause (this last case is required because holes in the tagged type -- might be filled with components from child types). + procedure Expand_Iterator_Loop (N : Node_Id); + -- Expand loops over arrays and containers that use the form "for X of C" + -- with an optional subtype mark, and "for Y in C". + function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id; -- Generate the necessary code for controlled and tagged assignment, that -- is to say, finalization of the target before, adjustment of the target @@ -2747,6 +2751,201 @@ package body Exp_Ch5 is end if; end Expand_N_If_Statement; + -------------------------- + -- Expand_Iterator_Loop -- + -------------------------- + + procedure Expand_Iterator_Loop (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Isc : constant Node_Id := Iteration_Scheme (N); + I_Spec : constant Node_Id := Iterator_Specification (Isc); + Id : constant Entity_Id := Defining_Identifier (I_Spec); + Container : constant Entity_Id := Entity (Name (I_Spec)); + + Typ : constant Entity_Id := Etype (Container); + + Cursor : Entity_Id; + New_Loop : Node_Id; + Stats : List_Id; + + begin + if Is_Array_Type (Typ) then + if Of_Present (I_Spec) then + Cursor := Make_Temporary (Loc, 'C'); + + -- For Elem of Arr loop .. + + declare + Decl : constant Node_Id := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => + New_Occurrence_Of (Component_Type (Typ), Loc), + Name => Make_Indexed_Component (Loc, + Prefix => New_Occurrence_Of (Container, Loc), + Expressions => + New_List (New_Occurrence_Of (Cursor, Loc)))); + begin + Stats := Statements (N); + Prepend (Decl, Stats); + + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Cursor, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Container, Loc), + Attribute_Name => Name_Range), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => Stats, + End_Label => Empty); + end; + + else + + -- For Index in Array loop + -- + -- The cursor (index into the array) is the source Id. + + Cursor := Id; + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Cursor, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Container, Loc), + Attribute_Name => Name_Range), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => Statements (N), + End_Label => Empty); + end if; + + else + + -- Iterators over containers. In both cases these require a + -- cursor of the proper type. + + -- Cursor : P.Cursor_Type := Container.First; + -- while Cursor /= P.No_Element loop + + -- -- for the "of" form, the element name renames + -- -- the element denoted by the cursor. + + -- Obj : P.Element_Type renames Element (Cursor); + -- Statements; + -- P.Next (Cursor); + -- end loop; + -- + -- with the obvious replacements if "reverse" is specified. + + declare + Element_Type : constant Entity_Id := Etype (Id); + Pack : constant Entity_Id := Scope (Etype (Container)); + + Name_Init : Name_Id; + Name_Step : Name_Id; + + Cond : Node_Id; + Cursor_Decl : Node_Id; + Renaming_Decl : Node_Id; + + begin + Stats := Statements (N); + + if Of_Present (I_Spec) then + Cursor := Make_Temporary (Loc, 'C'); + + else + Cursor := Id; + end if; + + if Reverse_Present (I_Spec) then + + -- Must verify that the container has a reverse iterator ??? + + Name_Init := Name_Last; + Name_Step := Name_Previous; + + else + Name_Init := Name_First; + Name_Step := Name_Next; + end if; + + -- C : Cursor_Type := Container.First; + + Cursor_Decl := Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Pack, Loc), + Selector_Name => + Make_Identifier (Loc, Name_Cursor)), + Expression => + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Container, Loc), + Selector_Name => Make_Identifier (Loc, Name_Init))); + + Insert_Action (N, Cursor_Decl); + + -- while C /= No_Element loop + + Cond := Make_Op_Ne (Loc, + Left_Opnd => New_Occurrence_Of (Cursor, Loc), + Right_Opnd => Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Pack, Loc), + Selector_Name => Make_Identifier (Loc, + Chars => Name_No_Element))); + + if Of_Present (I_Spec) then + + -- Id : Element_Type renames Pack.Element (Cursor); + + Renaming_Decl := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => New_Occurrence_Of (Element_Type, Loc), + Name => Make_Indexed_Component (Loc, + Prefix => + Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Pack, Loc), + Selector_Name => + Make_Identifier (Loc, Chars => Name_Element)), + Expressions => + New_List (New_Occurrence_Of (Cursor, Loc)))); + + Prepend (Renaming_Decl, Stats); + end if; + + -- For both iterator forms, add call to Next to advance cursor. + + Append_To (Stats, + Make_Procedure_Call_Statement (Loc, + Name => Make_Selected_Component (Loc, + Prefix => New_Occurrence_Of (Pack, Loc), + Selector_Name => Make_Identifier (Loc, Name_Step)), + Parameter_Associations => + New_List (New_Occurrence_Of (Cursor, Loc)))); + + New_Loop := Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Condition => Cond), + Statements => Stats, + End_Label => Empty); + end; + end if; + + -- Set_Analyzed (I_Spec); + Rewrite (N, New_Loop); + Analyze (N); + end Expand_Iterator_Loop; + ----------------------------- -- Expand_N_Loop_Statement -- ----------------------------- @@ -2755,7 +2954,8 @@ package body Exp_Ch5 is -- 2. Deal with while condition for C/Fortran boolean -- 3. Deal with loops with a non-standard enumeration type range -- 4. Deal with while loops where Condition_Actions is set - -- 5. Insert polling call if required + -- 5. Deal with loops with iterators over arrays and containers + -- 6. Insert polling call if required procedure Expand_N_Loop_Statement (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); @@ -2955,6 +3155,11 @@ package body Exp_Ch5 is Analyze (N); end; + + elsif Present (Isc) + and then Present (Iterator_Specification (Isc)) + then + Expand_Iterator_Loop (N); end if; end Expand_N_Loop_Statement; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1ce017b280f..3a94befeffb 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2828,6 +2828,7 @@ package body Exp_Util is N_Index_Or_Discriminant_Constraint | N_Indexed_Component | N_Integer_Literal | + N_Iterator_Specification | N_Itype_Reference | N_Label | N_Loop_Parameter_Specification | diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index a613e1f17df..8ab04ef1be8 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2514,7 +2514,8 @@ package body Ch4 is -- for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE function P_Quantified_Expression return Node_Id is - Node1 : Node_Id; + I_Spec : Node_Id; + Node1 : Node_Id; begin Scan; -- past FOR @@ -2536,7 +2537,13 @@ package body Ch4 is end if; Scan; - Set_Loop_Parameter_Specification (Node1, P_Loop_Parameter_Specification); + I_Spec := P_Loop_Parameter_Specification; + + if Nkind (I_Spec) = N_Loop_Parameter_Specification then + Set_Loop_Parameter_Specification (Node1, I_Spec); + else + Set_Iterator_Specification (Node1, I_Spec); + end if; if Token = Tok_Arrow then Scan; diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 15e290eee7f..e6f28c9efba 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -60,6 +60,11 @@ package body Ch5 is -- the N_Identifier node for the label on the loop. If Loop_Name is -- Empty on entry (the default), then the for statement is unlabeled. + function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id; + -- Parse an iterator specification. The defining identifier has already + -- been scanned, as it is the common prefix between loop and iterator + -- specification. + function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id; -- Parse loop statement. If Loop_Name is non-Empty on entry, it is -- the N_Identifier node for the label on the loop. If Loop_Name is @@ -1552,6 +1557,7 @@ package body Ch5 is Iter_Scheme_Node : Node_Id; Loop_For_Flag : Boolean; Created_Name : Node_Id; + Spec : Node_Id; begin Push_Scope_Stack; @@ -1563,8 +1569,13 @@ package body Ch5 is Loop_For_Flag := (Prev_Token = Tok_Loop); Scan; -- past FOR Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr); - Set_Loop_Parameter_Specification - (Iter_Scheme_Node, P_Loop_Parameter_Specification); + Spec := P_Loop_Parameter_Specification; + if Nkind (Spec) = N_Loop_Parameter_Specification then + Set_Loop_Parameter_Specification + (Iter_Scheme_Node, Spec); + else + Set_Iterator_Specification (Iter_Scheme_Node, Spec); + end if; -- The following is a special test so that a miswritten for loop such -- as "loop for I in 1..10;" is handled nicely, without making an extra @@ -1686,11 +1697,27 @@ package body Ch5 is Scan_State : Saved_Scan_State; begin - Loop_Param_Specification_Node := - New_Node (N_Loop_Parameter_Specification, Token_Ptr); Save_Scan_State (Scan_State); ID_Node := P_Defining_Identifier (C_In); + + -- If the next token is OF it indicates the Ada2012 iterator. If the + -- next token is a colon, the iterator includes a subtype indication + -- for the bound variable of the iteration. Otherwise we parse the + -- construct as a loop parameter specification. Note that the form: + -- "for A in B" is ambiguous, and must be resolved semantically: if B + -- is a discrete subtype this is a loop specification, but if it is an + -- expression it is an iterator specification. Ambiguity is resolved + -- during analysis of the loop parameter specification. + + if Token = Tok_Of + or else Token = Tok_Colon + then + return P_Iterator_Specification (ID_Node); + end if; + + Loop_Param_Specification_Node := + New_Node (N_Loop_Parameter_Specification, Token_Ptr); Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node); if Token = Tok_Left_Paren then @@ -1720,6 +1747,40 @@ package body Ch5 is return Error; end P_Loop_Parameter_Specification; + ---------------------------------- + -- 5.5.1 Iterator_Specification -- + ---------------------------------- + + function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id is + Node1 : Node_Id; + begin + Node1 := New_Node (N_Iterator_Specification, Token_Ptr); + Set_Defining_Identifier (Node1, Def_Id); + + if Token = Tok_Colon then + Scan; -- past : + Set_Subtype_Indication (Node1, P_Subtype_Indication); + end if; + + if Token = Tok_Of then + Set_Of_Present (Node1); + Scan; -- past OF + elsif Token = Tok_In then + Scan; -- past IN + else + return Error; + end if; + + if Token = Tok_Reverse then + Scan; -- past REVERSE + Set_Reverse_Present (Node1, True); + end if; + + Set_Name (Node1, P_Name); + + return Node1; + end P_Iterator_Specification; + -------------------------- -- 5.6 Block Statement -- -------------------------- diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index 42447c2357f..9a9809cb070 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -302,6 +302,9 @@ package body Sem is when N_Integer_Literal => Analyze_Integer_Literal (N); + when N_Iterator_Specification => + Analyze_Iterator_Specification (N); + when N_Itype_Reference => Analyze_Itype_Reference (N); diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index ee23d17c529..f19ead7117d 100755 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -537,6 +537,25 @@ package body Sem_Aux is end if; end Is_Derived_Type; + ----------------------- + -- Is_Generic_Formal -- + ----------------------- + + function Is_Generic_Formal (E : Entity_Id) return Boolean is + Kind : Node_Kind; + begin + if No (E) then + return False; + else + Kind := Nkind (Parent (E)); + return + Nkind_In (Kind, N_Formal_Object_Declaration, + N_Formal_Package_Declaration, + N_Formal_Type_Declaration) + or else Is_Formal_Subprogram (E); + end if; + end Is_Generic_Formal; + --------------------------- -- Is_Indefinite_Subtype -- --------------------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 8ef11ec8a7a..25f95ab6e99 100755 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -159,6 +159,11 @@ package Sem_Aux is -- Determines if the given entity Ent is a derived type. Result is always -- false if argument is not a type. + function Is_Generic_Formal (E : Entity_Id) return Boolean; + -- Determine whether E is a generic formal parameter. In particular this is + -- used to set the visibility of generic formals of a generic package + -- declared with a box or with partial parametrization. + function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean; -- Ent is any entity. Determines if given entity is an unconstrained array -- type or subtype, a discriminated record type or subtype with no initial diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 64db5206d0d..a303807a80d 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1734,6 +1734,10 @@ package body Sem_Ch5 is -- Start of processing for Analyze_Iteration_Scheme begin + if Analyzed (N) then + return; + end if; + -- For an infinite loop, there is no iteration scheme if No (N) then @@ -1753,6 +1757,9 @@ package body Sem_Ch5 is Set_Current_Value_Condition (N); return; + elsif Present (Iterator_Specification (N)) then + Analyze_Iterator_Specification (Iterator_Specification (N)); + -- Else we have a FOR loop else @@ -1795,6 +1802,31 @@ package body Sem_Ch5 is Process_Bounds (DS); else Analyze (DS); + + if Nkind (DS) = N_Function_Call + or else + (Is_Entity_Name (DS) + and then not Is_Type (Entity (DS))) + then + + -- this is an iterator specification. Rewrite as + -- such and analyze. + + declare + I_Spec : constant Node_Id := + Make_Iterator_Specification (Sloc (LP), + Defining_Identifier => Relocate_Node (Id), + Name => Relocate_Node (DS), + Subtype_Indication => Empty, + Reverse_Present => Reverse_Present (LP)); + + begin + Set_Iterator_Specification (N, I_Spec); + Set_Loop_Parameter_Specification (N, Empty); + Analyze_Iterator_Specification (I_Spec); + return; + end; + end if; end if; if DS = Error then @@ -1938,6 +1970,73 @@ package body Sem_Ch5 is end if; end Analyze_Iteration_Scheme; + ------------------------------------- + -- Analyze_Iterator_Specification -- + ------------------------------------- + + procedure Analyze_Iterator_Specification (N : Node_Id) is + Def_Id : constant Node_Id := Defining_Identifier (N); + Subt : constant Node_Id := Subtype_Indication (N); + Container : constant Node_Id := Name (N); + + Ent : Entity_Id; + Typ : Entity_Id; + + begin + Enter_Name (Def_Id); + Set_Ekind (Def_Id, E_Variable); + + if Present (Subt) then + Analyze (Subt); + end if; + + Analyze_And_Resolve (Container); + Typ := Etype (Container); + + if Is_Array_Type (Typ) then + if Of_Present (N) then + Set_Etype (Def_Id, Component_Type (Typ)); + + else + Set_Etype (Def_Id, Etype (First_Index (Typ))); + end if; + + else + -- Iteration over a container. + + Set_Ekind (Def_Id, E_Loop_Parameter); + if Of_Present (N) then + + -- Find the Element_Type in the package instance that defines + -- the container type. + + Ent := First_Entity (Scope (Typ)); + while Present (Ent) loop + if Chars (Ent) = Name_Element_Type then + Set_Etype (Def_Id, Ent); + exit; + end if; + + Next_Entity (Ent); + end loop; + + else + + -- Find the Cursor type in similar fashion. + + Ent := First_Entity (Scope (Typ)); + while Present (Ent) loop + if Chars (Ent) = Name_Cursor then + Set_Etype (Def_Id, Ent); + exit; + end if; + + Next_Entity (Ent); + end loop; + end if; + end if; + end Analyze_Iterator_Specification; + ------------------- -- Analyze_Label -- ------------------- diff --git a/gcc/ada/sem_ch5.ads b/gcc/ada/sem_ch5.ads index 48e9764f61a..fdf09db32d5 100644 --- a/gcc/ada/sem_ch5.ads +++ b/gcc/ada/sem_ch5.ads @@ -34,6 +34,7 @@ package Sem_Ch5 is procedure Analyze_Goto_Statement (N : Node_Id); procedure Analyze_If_Statement (N : Node_Id); procedure Analyze_Implicit_Label_Declaration (N : Node_Id); + procedure Analyze_Iterator_Specification (N : Node_Id); procedure Analyze_Iteration_Scheme (N : Node_Id); procedure Analyze_Label (N : Node_Id); procedure Analyze_Loop_Statement (N : Node_Id); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d53e483dfc3..109ee580976 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6559,25 +6559,6 @@ package body Sem_Util is end if; end Is_Fully_Initialized_Variant; - ----------------------- - -- Is_Generic_Formal -- - ----------------------- - - function Is_Generic_Formal (E : Entity_Id) return Boolean is - Kind : Node_Kind; - begin - if No (E) then - return False; - else - Kind := Nkind (Parent (E)); - return - Nkind_In (Kind, N_Formal_Object_Declaration, - N_Formal_Package_Declaration, - N_Formal_Type_Declaration) - or else Is_Formal_Subprogram (E); - end if; - end Is_Generic_Formal; - ------------ -- Is_LHS -- ------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 94786a1849b..be4987b9494 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -733,11 +733,6 @@ package Sem_Util is -- means that the result returned is not crucial, but should err on the -- side of thinking things are fully initialized if it does not know. - function Is_Generic_Formal (E : Entity_Id) return Boolean; - -- Determine whether E is a generic formal parameter. In particular this is - -- used to set the visibility of generic formals of a generic package - -- declared with a box or with partial parametrization. - function Is_Inherited_Operation (E : Entity_Id) return Boolean; -- E is a subprogram. Return True is E is an implicit operation inherited -- by a derived type declarations. diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index dd09e4c5c20..fe6bf8156c8 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -744,6 +744,7 @@ package body Sinfo is or else NT (N).Nkind = N_Full_Type_Declaration or else NT (N).Nkind = N_Implicit_Label_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification or else NT (N).Nkind = N_Number_Declaration or else NT (N).Nkind = N_Object_Declaration @@ -1866,6 +1867,15 @@ package body Sinfo is return Node2 (N); end Iteration_Scheme; + function Iterator_Specification + (N : Node_Id) return Node_Id is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iteration_Scheme + or else NT (N).Nkind = N_Quantified_Expression); + return Node2 (N); + end Iterator_Specification; + function Itype (N : Node_Id) return Node_Id is begin @@ -2086,6 +2096,7 @@ package body Sinfo is or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration or else NT (N).Nkind = N_Goto_Statement + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Object_Renaming_Declaration or else NT (N).Nkind = N_Package_Instantiation or else NT (N).Nkind = N_Package_Renaming_Declaration @@ -2270,6 +2281,14 @@ package body Sinfo is return Node4 (N); end Object_Definition; + function Of_Present + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iterator_Specification); + return Flag16 (N); + end Of_Present; + function Original_Discriminant (N : Node_Id) return Node_Id is begin @@ -2630,6 +2649,7 @@ package body Sinfo is (N : Node_Id) return Boolean is begin pragma Assert (False + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification); return Flag15 (N); end Reverse_Present; @@ -2825,6 +2845,7 @@ package body Sinfo is or else NT (N).Nkind = N_Access_To_Object_Definition or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Private_Extension_Declaration or else NT (N).Nkind = N_Subtype_Declaration); return Node5 (N); @@ -3742,6 +3763,7 @@ package body Sinfo is or else NT (N).Nkind = N_Full_Type_Declaration or else NT (N).Nkind = N_Implicit_Label_Declaration or else NT (N).Nkind = N_Incomplete_Type_Declaration + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification or else NT (N).Nkind = N_Number_Declaration or else NT (N).Nkind = N_Object_Declaration @@ -4856,6 +4878,15 @@ package body Sinfo is Set_Node2_With_Parent (N, Val); end Set_Iteration_Scheme; + procedure Set_Iterator_Specification + (N : Node_Id; Val : Node_Id) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iteration_Scheme + or else NT (N).Nkind = N_Quantified_Expression); + Set_Node2_With_Parent (N, Val); + end Set_Iterator_Specification; + procedure Set_Itype (N : Node_Id; Val : Entity_Id) is begin @@ -5076,6 +5107,7 @@ package body Sinfo is or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration or else NT (N).Nkind = N_Goto_Statement + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Object_Renaming_Declaration or else NT (N).Nkind = N_Package_Instantiation or else NT (N).Nkind = N_Package_Renaming_Declaration @@ -5260,6 +5292,14 @@ package body Sinfo is Set_Node4_With_Parent (N, Val); end Set_Object_Definition; + procedure Set_Of_Present + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Iterator_Specification); + Set_Flag16 (N, Val); + end Set_Of_Present; + procedure Set_Original_Discriminant (N : Node_Id; Val : Node_Id) is begin @@ -5620,6 +5660,7 @@ package body Sinfo is (N : Node_Id; Val : Boolean := True) is begin pragma Assert (False + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Loop_Parameter_Specification); Set_Flag15 (N, Val); end Set_Reverse_Present; @@ -5815,6 +5856,7 @@ package body Sinfo is or else NT (N).Nkind = N_Access_To_Object_Definition or else NT (N).Nkind = N_Component_Definition or else NT (N).Nkind = N_Derived_Type_Definition + or else NT (N).Nkind = N_Iterator_Specification or else NT (N).Nkind = N_Private_Extension_Declaration or else NT (N).Nkind = N_Subtype_Declaration); Set_Node5_With_Parent (N, Val); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index f47892a0ab1..2b145cca14c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1544,6 +1544,10 @@ package Sinfo is -- is used for properly setting out of range values for use by pragmas -- Initialize_Scalars and Normalize_Scalars. + -- Of_Present (Flag16) + -- Present in N_Iterastor_Specification nodes, to mark the Ada2012 iterator + -- form over arrays and containers. + -- Original_Discriminant (Node2-Sem) -- Present in identifiers. Used in references to discriminants that -- appear in generic units. Because the names of the discriminants may be @@ -3829,6 +3833,7 @@ package Sinfo is -- N_Quantified_Expression -- Sloc points to FOR + -- Iterator_Specification (Node2) (set to Empty if not Present) -- Loop_Parameter_Specification (Node4) -- Condition (Node1) -- All_Present (Flag15) @@ -4164,7 +4169,11 @@ package Sinfo is -------------------------- -- ITERATION_SCHEME ::= - -- while CONDITION | for LOOP_PARAMETER_SPECIFICATION + -- while CONDITION | for LOOP_PARAMETER_SPECIFICATION | + -- for ITERATOR_SPECIFICATION + + -- Only one of (Iterator_Specification, Loop_Parameter_Specification) + -- is present at a time, the other one is empty. -- Gigi restriction: This expander ensures that the type of the -- Condition field is always Standard.Boolean, even if the type @@ -4174,6 +4183,7 @@ package Sinfo is -- Sloc points to WHILE or FOR -- Condition (Node1) (set to Empty if FOR case) -- Condition_Actions (List3-Sem) + -- Iterator_Specification (Node2) (set to Empty if not Present) -- Loop_Parameter_Specification (Node4) (set to Empty if WHILE case) --------------------------------------- @@ -4189,6 +4199,22 @@ package Sinfo is -- Reverse_Present (Flag15) -- Discrete_Subtype_Definition (Node4) + ---------------------------------- + -- 5.5.1 Iterator specification -- + ---------------------------------- + + -- ITERATOR_SPECIFICATION ::= + -- DEFINING_IDENTIFIER in [reverse] NAME + -- DEFINING_IDENTIFIER [: SUBTYPE_INDICATION] of [reverse] NAME + + -- N_Iterator_Specification + -- Sloc points to defining identifier + -- Defining_Identifier (Node1) + -- Name (Node2) + -- Reverse_Present (Flag15) + -- Of_Present (Flag16) + -- Subtype_Indication (Node5) + -------------------------- -- 5.6 Block Statement -- -------------------------- @@ -7500,6 +7526,7 @@ package Sinfo is N_Formal_Type_Declaration, N_Full_Type_Declaration, N_Incomplete_Type_Declaration, + N_Iterator_Specification, N_Loop_Parameter_Specification, N_Object_Declaration, N_Parameterized_Expression, @@ -8492,6 +8519,9 @@ package Sinfo is function Iteration_Scheme (N : Node_Id) return Node_Id; -- Node2 + function Iterator_Specification + (N : Node_Id) return Node_Id; -- Node2 + function Itype (N : Node_Id) return Entity_Id; -- Node1 @@ -8612,6 +8642,9 @@ package Sinfo is function Object_Definition (N : Node_Id) return Node_Id; -- Node4 + function Of_Present + (N : Node_Id) return Boolean; -- Flag16 + function Original_Discriminant (N : Node_Id) return Node_Id; -- Node2 @@ -9446,6 +9479,9 @@ package Sinfo is procedure Set_Iteration_Scheme (N : Node_Id; Val : Node_Id); -- Node2 + procedure Set_Iterator_Specification + (N : Node_Id; Val : Node_Id); -- Node2 + procedure Set_Itype (N : Node_Id; Val : Entity_Id); -- Node1 @@ -9566,6 +9602,9 @@ package Sinfo is procedure Set_Object_Definition (N : Node_Id; Val : Node_Id); -- Node4 + procedure Set_Of_Present + (N : Node_Id; Val : Boolean := True); -- Flag16 + procedure Set_Original_Discriminant (N : Node_Id; Val : Node_Id); -- Node2 @@ -10492,7 +10531,7 @@ package Sinfo is N_Quantified_Expression => (1 => True, -- Condition (Node1) - 2 => False, -- unused + 2 => True, -- Iterator_Specification 3 => False, -- unused 4 => True, -- Loop_Parameter_Specification (Node4) 5 => False), -- Etype (Node5-Sem) @@ -10576,7 +10615,7 @@ package Sinfo is N_Iteration_Scheme => (1 => True, -- Condition (Node1) - 2 => False, -- unused + 2 => True, -- Iterator_Specification (Node2) 3 => False, -- Condition_Actions (List3-Sem) 4 => True, -- Loop_Parameter_Specification (Node4) 5 => False), -- unused @@ -10588,6 +10627,13 @@ package Sinfo is 4 => True, -- Discrete_Subtype_Definition (Node4) 5 => False), -- unused + N_Iterator_Specification => + (1 => True, -- Defining_Identifier (Node1) + 2 => True, -- Name (Node2) + 3 => False, -- Unused + 4 => False, -- Unused + 5 => True), -- Subtype_Indication (Node5) + N_Block_Statement => (1 => True, -- Identifier (Node1) 2 => True, -- Declarations (List2) diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 29cc172c20b..91f50e46712 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1198,6 +1198,14 @@ package Snames is Name_Unaligned_Valid : constant Name_Id := N + $; + -- Names used to implement iterators over predefined containers. + + Name_Cursor : constant Name_Id := N + $; + Name_Element : constant Name_Id := N + $; + Name_Element_Type : constant Name_Id := N + $; + Name_No_Element : constant Name_Id := N + $; + Name_Previous : constant Name_Id := N + $; + -- Ada 05 reserved words First_2005_Reserved_Word : constant Name_Id := N + $; diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index e2bb1734c8b..627fb2f28bd 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -1995,11 +1995,36 @@ package body Sprint is Sprint_Node (Condition (Node)); else Write_Str_With_Col_Check_Sloc ("for "); - Sprint_Node (Loop_Parameter_Specification (Node)); + if Present (Iterator_Specification (Node)) then + Sprint_Node (Iterator_Specification (Node)); + else + Sprint_Node (Loop_Parameter_Specification (Node)); + end if; end if; Write_Char (' '); + when N_Iterator_Specification => + Set_Debug_Sloc; + Write_Id (Defining_Identifier (Node)); + + if Present (Subtype_Indication (Node)) then + Write_Str_With_Col_Check (" : "); + Sprint_Node (Subtype_Indication (Node)); + end if; + + if Of_Present (Node) then + Write_Str_With_Col_Check (" of "); + else + Write_Str_With_Col_Check (" in "); + end if; + + if Reverse_Present (Node) then + Write_Str_With_Col_Check ("reverse "); + end if; + + Sprint_Node (Name (Node)); + when N_Itype_Reference => Write_Indent_Str_Sloc ("reference "); Write_Id (Itype (Node)); -- 2.30.2