From patchwork Fri Mar 9 14:57:53 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 145727 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id AEE06B6FA3 for ; Sat, 10 Mar 2012 01:58:37 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1331909918; h=Comment: DomainKey-Signature:Received:Received: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; bh=udf4h9Nn09e8EnonW/sV V/9fgnU=; b=Stbg590LlMpM5bMRXPZLjkteotoXzFvS1QeCk2+n4U6ffBReDneG Od4YmtGpclCEfZNypR+pLnrcWJzTf9N7pT42qohyeCYLSw+rGf9MPhjRuB00fjMM DkL3rjs52rbqvGnnvrl3Fq4TIxNOk45Qa7kSBaIfDM1lcOtbse5fCMg= 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=X/1p6XDS6Ix2df1/2LSvQ2NU6vTS1oMH6RZFSPM6fVruRkNI99MKhK+StJfCIN PRM81ltFADZxk/sRcTWqV0VSryH067swqpxBUqhzLbdptRvaZrPI+seTe9Did3pR jUQUUTm5p9kJ/o7VUvNIIbnp8ud16GzgtKgQ6FBMkMZb8=; Received: (qmail 12561 invoked by alias); 9 Mar 2012 14:58:28 -0000 Received: (qmail 12403 invoked by uid 22791); 9 Mar 2012 14:58:20 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Fri, 09 Mar 2012 14:57:54 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B0CC11C6BAC; Fri, 9 Mar 2012 09:57:53 -0500 (EST) 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 33Z+j9bY+yQQ; Fri, 9 Mar 2012 09:57:53 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 8E1B41C6BAA; Fri, 9 Mar 2012 09:57:53 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 84BE43FEE8; Fri, 9 Mar 2012 09:57:53 -0500 (EST) Date: Fri, 9 Mar 2012 09:57:53 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Pucci Subject: [Ada] Expansion of "of" iterator loop over multidimensional arrays Message-ID: <20120309145753.GA8278@adacore.com> MIME-Version: 1.0 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 List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This patch implements the expansion of the so-called "of" iterator over multidimensional arrays (for Element of Array loop). Tested on x86_64-pc-linux-gnu, committed on trunk 2012-03-09 Vincent Pucci * exp_ch5.adb (Expand_Iterator_Loop): Call to Expand_Iterator_Loop_Over_Array added. (Expand_Iterator_Loop_Over_Array): New routine. Expansion of "of" iterator loop over arrays. Multidimensional array case added. Index: exp_ch5.adb =================================================================== --- exp_ch5.adb (revision 185136) +++ exp_ch5.adb (working copy) @@ -107,6 +107,9 @@ -- Expand loop over arrays and containers that uses the form "for X of C" -- with an optional subtype mark, or "for Y in C". + procedure Expand_Iterator_Loop_Over_Array (N : Node_Id); + -- Expand loop over arrays that uses the form "for X of C" + procedure Expand_Predicated_Loop (N : Node_Id); -- Expand for loop over predicated subtype @@ -2946,369 +2949,432 @@ -- Processing for arrays if Is_Array_Type (Container_Typ) then + Expand_Iterator_Loop_Over_Array (N); + return; + end if; - -- for Element of Array loop - -- - -- This case requires an internally generated cursor to iterate over - -- the array. + -- Processing for containers - if Of_Present (I_Spec) then - Iterator := Make_Temporary (Loc, 'C'); + -- For an "of" iterator the name is a container expression, which + -- is transformed into a call to the default iterator. - -- Generate: - -- Element : Component_Type renames Container (Iterator); + -- For an iterator of the form "in" the name is a function call + -- that delivers an iterator type. - Prepend_To (Stats, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Id, - Subtype_Mark => - New_Reference_To (Component_Type (Container_Typ), Loc), - Name => - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Container), - Expressions => New_List ( - New_Reference_To (Iterator, Loc))))); + -- In both cases, analysis of the iterator has introduced an object + -- declaration to capture the domain, so that Container is an entity. - -- for Index in Array loop + -- The for loop is expanded into a while loop which uses a container + -- specific cursor to desgnate each element. - -- This case utilizes the already given iterator name + -- Iter : Iterator_Type := Container.Iterate; + -- Cursor : Cursor_type := First (Iter); + -- while Has_Element (Iter) loop + -- declare + -- -- The block is added when Element_Type is controlled + -- Obj : Pack.Element_Type := Element (Cursor); + -- -- for the "of" loop form + -- begin + -- + -- end; + + -- Cursor := Iter.Next (Cursor); + -- end loop; + + -- If "reverse" is present, then the initialization of the cursor + -- uses Last and the step becomes Prev. Pack is the name of the + -- scope where the container package is instantiated. + + declare + Element_Type : constant Entity_Id := Etype (Id); + Iter_Type : Entity_Id; + Pack : Entity_Id; + Decl : Node_Id; + Name_Init : Name_Id; + Name_Step : Name_Id; + + begin + -- The type of the iterator is the return type of the Iterate + -- function used. For the "of" form this is the default iterator + -- for the type, otherwise it is the type of the explicit + -- function used in the iterator specification. The most common + -- case will be an Iterate function in the container package. + + -- The primitive operations of the container type may not be + -- use-visible, so we introduce the name of the enclosing package + -- in the declarations below. The Iterator type is declared in a + -- an instance within the container package itself. + + -- If the container type is a derived type, the cursor type is + -- found in the package of the parent type. + + if Is_Derived_Type (Container_Typ) then + Pack := Scope (Root_Type (Container_Typ)); else - Iterator := Id; + Pack := Scope (Container_Typ); end if; - -- Generate: - -- for Iterator in [reverse] Container'Range loop - -- Element : Component_Type renames Container (Iterator); - -- -- for the "of" form + Iter_Type := Etype (Name (I_Spec)); - -- - -- end loop; + -- The "of" case uses an internally generated cursor whose type + -- is found in the container package. The domain of iteration + -- is expanded into a call to the default Iterator function, but + -- this expansion does not take place in quantified expressions + -- that are analyzed with expansion disabled, and in that case the + -- type of the iterator must be obtained from the aspect. - New_Loop := - Make_Loop_Statement (Loc, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Loop_Parameter_Specification => - Make_Loop_Parameter_Specification (Loc, - Defining_Identifier => Iterator, - Discrete_Subtype_Definition => - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Container), - Attribute_Name => Name_Range), - Reverse_Present => Reverse_Present (I_Spec))), - Statements => Stats, - End_Label => Empty); + if Of_Present (I_Spec) then + declare + Default_Iter : constant Entity_Id := + Entity + (Find_Aspect + (Etype (Container), + Aspect_Default_Iterator)); - -- Processing for containers + Container_Arg : Node_Id; + Ent : Entity_Id; - else - -- For an "of" iterator the name is a container expression, which - -- is transformed into a call to the default iterator. + begin + Cursor := Make_Temporary (Loc, 'I'); - -- For an iterator of the form "in" the name is a function call - -- that delivers an iterator type. + -- For an container element iterator, the iterator type + -- is obtained from the corresponding aspect. - -- In both cases, analysis of the iterator has introduced an object - -- declaration to capture the domain, so that Container is an entity. + Iter_Type := Etype (Default_Iter); + Pack := Scope (Iter_Type); - -- The for loop is expanded into a while loop which uses a container - -- specific cursor to desgnate each element. + -- Rewrite domain of iteration as a call to the default + -- iterator for the container type. If the container is + -- a derived type and the aspect is inherited, convert + -- container to parent type. The Cursor type is also + -- inherited from the scope of the parent. - -- Iter : Iterator_Type := Container.Iterate; - -- Cursor : Cursor_type := First (Iter); - -- while Has_Element (Iter) loop - -- declare - -- -- The block is added when Element_Type is controlled + if Base_Type (Etype (Container)) = + Base_Type (Etype (First_Formal (Default_Iter))) + then + Container_Arg := New_Copy_Tree (Container); - -- Obj : Pack.Element_Type := Element (Cursor); - -- -- for the "of" loop form - -- begin - -- - -- end; + else + Container_Arg := + Make_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of + (Etype (First_Formal (Default_Iter)), Loc), + Expression => New_Copy_Tree (Container)); + end if; - -- Cursor := Iter.Next (Cursor); - -- end loop; + Rewrite (Name (I_Spec), + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Default_Iter, Loc), + Parameter_Associations => + New_List (Container_Arg))); + Analyze_And_Resolve (Name (I_Spec)); - -- If "reverse" is present, then the initialization of the cursor - -- uses Last and the step becomes Prev. Pack is the name of the - -- scope where the container package is instantiated. + -- Find cursor type in proper iterator package, which is an + -- instantiation of Iterator_Interfaces. - declare - Element_Type : constant Entity_Id := Etype (Id); - Iter_Type : Entity_Id; - Pack : Entity_Id; - Decl : Node_Id; - Name_Init : Name_Id; - Name_Step : Name_Id; + Ent := First_Entity (Pack); + while Present (Ent) loop + if Chars (Ent) = Name_Cursor then + Set_Etype (Cursor, Etype (Ent)); + exit; + end if; + Next_Entity (Ent); + end loop; - begin - -- The type of the iterator is the return type of the Iterate - -- function used. For the "of" form this is the default iterator - -- for the type, otherwise it is the type of the explicit - -- function used in the iterator specification. The most common - -- case will be an Iterate function in the container package. + -- Generate: + -- Id : Element_Type renames Container (Cursor); + -- This assumes that the container type has an indexing + -- operation with Cursor. The check that this operation + -- exists is performed in Check_Container_Indexing. - -- The primitive operations of the container type may not be - -- use-visible, so we introduce the name of the enclosing package - -- in the declarations below. The Iterator type is declared in a - -- an instance within the container package itself. + Decl := + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => + New_Reference_To (Element_Type, Loc), + Name => + Make_Indexed_Component (Loc, + Prefix => Relocate_Node (Container_Arg), + Expressions => + New_List (New_Occurrence_Of (Cursor, Loc)))); - -- If the container type is a derived type, the cursor type is - -- found in the package of the parent type. + -- If the container holds controlled objects, wrap the loop + -- statements and element renaming declaration with a block. + -- This ensures that the result of Element (Cusor) is + -- cleaned up after each iteration of the loop. - if Is_Derived_Type (Container_Typ) then - Pack := Scope (Root_Type (Container_Typ)); - else - Pack := Scope (Container_Typ); - end if; + if Needs_Finalization (Element_Type) then - Iter_Type := Etype (Name (I_Spec)); + -- Generate: + -- declare + -- Id : Element_Type := Element (curosr); + -- begin + -- + -- end; - -- The "of" case uses an internally generated cursor whose type - -- is found in the container package. The domain of iteration - -- is expanded into a call to the default Iterator function, but - -- this expansion does not take place in quantified expressions - -- that are analyzed with expansion disabled, and in that case the - -- type of the iterator must be obtained from the aspect. + Stats := New_List ( + Make_Block_Statement (Loc, + Declarations => New_List (Decl), + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, + Statements => Stats))); - if Of_Present (I_Spec) then - declare - Default_Iter : constant Entity_Id := - Entity - (Find_Aspect - (Etype (Container), - Aspect_Default_Iterator)); + -- Elements do not need finalization - Container_Arg : Node_Id; - Ent : Entity_Id; + else + Prepend_To (Stats, Decl); + end if; + end; - begin - Cursor := Make_Temporary (Loc, 'I'); + -- X in Iterate (S) : type of iterator is type of explicitly + -- given Iterate function, and the loop variable is the cursor. + -- It will be assigned in the loop and must be a variable. - -- For an container element iterator, the iterator type - -- is obtained from the corresponding aspect. + else + Cursor := Id; + Set_Ekind (Cursor, E_Variable); + end if; - Iter_Type := Etype (Default_Iter); - Pack := Scope (Iter_Type); + Iterator := Make_Temporary (Loc, 'I'); - -- Rewrite domain of iteration as a call to the default - -- iterator for the container type. If the container is - -- a derived type and the aspect is inherited, convert - -- container to parent type. The Cursor type is also - -- inherited from the scope of the parent. + -- Determine the advancement and initialization steps for the + -- cursor. - if Base_Type (Etype (Container)) = - Base_Type (Etype (First_Formal (Default_Iter))) - then - Container_Arg := New_Copy_Tree (Container); + -- Analysis of the expanded loop will verify that the container + -- has a reverse iterator. - else - Container_Arg := - Make_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of - (Etype (First_Formal (Default_Iter)), Loc), - Expression => New_Copy_Tree (Container)); - end if; + if Reverse_Present (I_Spec) then + Name_Init := Name_Last; + Name_Step := Name_Previous; - Rewrite (Name (I_Spec), - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Default_Iter, Loc), - Parameter_Associations => - New_List (Container_Arg))); - Analyze_And_Resolve (Name (I_Spec)); + else + Name_Init := Name_First; + Name_Step := Name_Next; + end if; - -- Find cursor type in proper iterator package, which is an - -- instantiation of Iterator_Interfaces. + -- For both iterator forms, add a call to the step operation to + -- advance the cursor. Generate: - Ent := First_Entity (Pack); - while Present (Ent) loop - if Chars (Ent) = Name_Cursor then - Set_Etype (Cursor, Etype (Ent)); - exit; - end if; - Next_Entity (Ent); - end loop; + -- Cursor := Iterator.Next (Cursor); - -- Generate: - -- Id : Element_Type renames Container (Cursor); - -- This assumes that the container type has an indexing - -- operation with Cursor. The check that this operation - -- exists is performed in Check_Container_Indexing. + -- or else - Decl := - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Id, - Subtype_Mark => - New_Reference_To (Element_Type, Loc), - Name => - Make_Indexed_Component (Loc, - Prefix => Relocate_Node (Container_Arg), - Expressions => - New_List (New_Occurrence_Of (Cursor, Loc)))); + -- Cursor := Next (Cursor); - -- If the container holds controlled objects, wrap the loop - -- statements and element renaming declaration with a block. - -- This ensures that the result of Element (Cusor) is - -- cleaned up after each iteration of the loop. + declare + Rhs : Node_Id; - if Needs_Finalization (Element_Type) then + begin + Rhs := + Make_Function_Call (Loc, + Name => + Make_Selected_Component (Loc, + Prefix => New_Reference_To (Iterator, Loc), + Selector_Name => Make_Identifier (Loc, Name_Step)), + Parameter_Associations => New_List ( + New_Reference_To (Cursor, Loc))); - -- Generate: - -- declare - -- Id : Element_Type := Element (curosr); - -- begin - -- - -- end; + Append_To (Stats, + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Cursor, Loc), + Expression => Rhs)); + end; - Stats := New_List ( - Make_Block_Statement (Loc, - Declarations => New_List (Decl), - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, - Statements => Stats))); + -- Generate: + -- while Iterator.Has_Element loop + -- + -- end loop; - -- Elements do not need finalization + -- Has_Element is the second actual in the iterator package - else - Prepend_To (Stats, Decl); - end if; - end; + New_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Condition => + Make_Function_Call (Loc, + Name => + New_Occurrence_Of ( + Next_Entity (First_Entity (Pack)), Loc), + Parameter_Associations => + New_List (New_Reference_To (Cursor, Loc)))), - -- X in Iterate (S) : type of iterator is type of explicitly - -- given Iterate function, and the loop variable is the cursor. - -- It will be assigned in the loop and must be a variable. + Statements => Stats, + End_Label => Empty); - else - Cursor := Id; - Set_Ekind (Cursor, E_Variable); - end if; + -- Create the declarations for Iterator and cursor and insert them + -- before the source loop. Given that the domain of iteration is + -- already an entity, the iterator is just a renaming of that + -- entity. Possible optimization ??? + -- Generate: - Iterator := Make_Temporary (Loc, 'I'); + -- I : Iterator_Type renames Container; + -- C : Cursor_Type := Container.[First | Last]; - -- Determine the advancement and initialization steps for the - -- cursor. + Insert_Action (N, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Iterator, + Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), + Name => Relocate_Node (Name (I_Spec)))); - -- Analysis of the expanded loop will verify that the container - -- has a reverse iterator. + -- Create declaration for cursor - if Reverse_Present (I_Spec) then - Name_Init := Name_Last; - Name_Step := Name_Previous; + declare + Decl : Node_Id; - else - Name_Init := Name_First; - Name_Step := Name_Next; - end if; + begin + Decl := + Make_Object_Declaration (Loc, + Defining_Identifier => Cursor, + Object_Definition => + New_Occurrence_Of (Etype (Cursor), Loc), + Expression => + Make_Selected_Component (Loc, + Prefix => New_Reference_To (Iterator, Loc), + Selector_Name => + Make_Identifier (Loc, Name_Init))); - -- For both iterator forms, add a call to the step operation to - -- advance the cursor. Generate: + -- The cursor is only modified in expanded code, so it appears + -- as unassigned to the warning machinery. We must suppress + -- this spurious warning explicitly. - -- Cursor := Iterator.Next (Cursor); + Set_Warnings_Off (Cursor); + Set_Assignment_OK (Decl); - -- or else + Insert_Action (N, Decl); + end; - -- Cursor := Next (Cursor); + -- If the range of iteration is given by a function call that + -- returns a container, the finalization actions have been saved + -- in the Condition_Actions of the iterator. Insert them now at + -- the head of the loop. - declare - Rhs : Node_Id; + if Present (Condition_Actions (Isc)) then + Insert_List_Before (N, Condition_Actions (Isc)); + end if; + end; - begin - Rhs := - Make_Function_Call (Loc, - Name => - Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), - Selector_Name => Make_Identifier (Loc, Name_Step)), - Parameter_Associations => New_List ( - New_Reference_To (Cursor, Loc))); + Rewrite (N, New_Loop); + Analyze (N); + end Expand_Iterator_Loop; - Append_To (Stats, - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Cursor, Loc), - Expression => Rhs)); - end; + ------------------------------------- + -- Expand_Iterator_Loop_Over_Array -- + ------------------------------------- - -- Generate: - -- while Iterator.Has_Element loop - -- - -- end loop; + procedure Expand_Iterator_Loop_Over_Array (N : Node_Id) is + Isc : constant Node_Id := Iteration_Scheme (N); + I_Spec : constant Node_Id := Iterator_Specification (Isc); + Array_Node : constant Node_Id := Name (I_Spec); + Array_Typ : constant Entity_Id := Base_Type (Etype (Array_Node)); + Array_Dim : constant Pos := Number_Dimensions (Array_Typ); + Id : constant Entity_Id := Defining_Identifier (I_Spec); + Loc : constant Source_Ptr := Sloc (N); + Stats : constant List_Id := Statements (N); + Core_Loop : Node_Id; + Ind_Comp : Node_Id; + Iterator : Entity_Id; - -- Has_Element is the second actual in the iterator package + -- Start of processing for Expand_Iterator_Loop_Over_Array - New_Loop := - Make_Loop_Statement (Loc, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Condition => - Make_Function_Call (Loc, - Name => - New_Occurrence_Of ( - Next_Entity (First_Entity (Pack)), Loc), - Parameter_Associations => - New_List ( - New_Reference_To (Cursor, Loc)))), + begin + -- for Element of Array loop - Statements => Stats, - End_Label => Empty); + -- This case requires an internally generated cursor to iterate over + -- the array. - -- Create the declarations for Iterator and cursor and insert them - -- before the source loop. Given that the domain of iteration is - -- already an entity, the iterator is just a renaming of that - -- entity. Possible optimization ??? - -- Generate: + if Of_Present (I_Spec) then + Iterator := Make_Temporary (Loc, 'C'); - -- I : Iterator_Type renames Container; - -- C : Cursor_Type := Container.[First | Last]; + -- Generate: + -- Element : Component_Type renames Array (Iterator); - Insert_Action (N, - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Iterator, - Subtype_Mark => New_Occurrence_Of (Iter_Type, Loc), - Name => Relocate_Node (Name (I_Spec)))); + Ind_Comp := + Make_Indexed_Component (Loc, + Prefix => Relocate_Node (Array_Node), + Expressions => New_List (New_Reference_To (Iterator, Loc))); - -- Create declaration for cursor + Prepend_To (Stats, + Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => Id, + Subtype_Mark => + New_Reference_To (Component_Type (Array_Typ), Loc), + Name => Ind_Comp)); - declare - Decl : Node_Id; + -- for Index in Array loop - begin - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Cursor, - Object_Definition => - New_Occurrence_Of (Etype (Cursor), Loc), - Expression => - Make_Selected_Component (Loc, - Prefix => New_Reference_To (Iterator, Loc), - Selector_Name => - Make_Identifier (Loc, Name_Init))); + -- This case utilizes the already given iterator name - -- The cursor is only modified in expanded code, so it appears - -- as unassigned to the warning machinery. We must suppress - -- this spurious warning explicitly. + else + Iterator := Id; + end if; - Set_Warnings_Off (Cursor); - Set_Assignment_OK (Decl); + -- Generate: - Insert_Action (N, Decl); - end; + -- for Iterator in [reverse] Array'Range (Array_Dim) loop + -- Element : Component_Type renames Array (Iterator); + -- + -- end loop; - -- If the range of iteration is given by a function call that - -- returns a container, the finalization actions have been saved - -- in the Condition_Actions of the iterator. Insert them now at - -- the head of the loop. + Core_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Iterator, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Array_Node), + Attribute_Name => Name_Range, + Expressions => New_List ( + Make_Integer_Literal (Loc, Array_Dim))), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => Stats, + End_Label => Empty); - if Present (Condition_Actions (Isc)) then - Insert_List_Before (N, Condition_Actions (Isc)); - end if; - end; + -- Processing for multidimensional array + + if Array_Dim > 1 then + for Dim in 1 .. Array_Dim - 1 loop + Iterator := Make_Temporary (Loc, 'C'); + + -- Generate the dimension loops starting from the innermost one + + -- for Iterator in [reverse] Array'Range (Array_Dim - Dim) loop + -- + -- end loop; + + Core_Loop := + Make_Loop_Statement (Loc, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Loop_Parameter_Specification => + Make_Loop_Parameter_Specification (Loc, + Defining_Identifier => Iterator, + Discrete_Subtype_Definition => + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Array_Node), + Attribute_Name => Name_Range, + Expressions => New_List ( + Make_Integer_Literal (Loc, Array_Dim - Dim))), + Reverse_Present => Reverse_Present (I_Spec))), + Statements => New_List (Core_Loop), + End_Label => Empty); + + -- Update the previously created object renaming declaration with + -- the new iterator. + + Prepend_To (Expressions (Ind_Comp), + New_Reference_To (Iterator, Loc)); + end loop; end if; - Rewrite (N, New_Loop); + Rewrite (N, Core_Loop); Analyze (N); - end Expand_Iterator_Loop; + end Expand_Iterator_Loop_Over_Array; ----------------------------- -- Expand_N_Loop_Statement --