-- 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
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 --
-----------------------------
-- 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);
Analyze (N);
end;
+
+ elsif Present (Isc)
+ and then Present (Iterator_Specification (Isc))
+ then
+ Expand_Iterator_Loop (N);
end if;
end Expand_N_Loop_Statement;
projects / gcc.git / blobdiff