-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- If the type is tagged, we may as well use the predefined
-- primitive assignment. This avoids inlining a lot of code
- -- and in the class-wide case, the assignment is replaced by
- -- dispatch call to _assign. Note that this cannot be done when
- -- discriminant checks are locally suppressed (as in extension
- -- aggregate expansions) because otherwise the discriminant
- -- check will be performed within the _assign call. It is also
- -- suppressed for assignments created by the expander that
- -- correspond to initializations, where we do want to copy the
- -- tag (No_Ctrl_Actions flag set True) by the expander and we
- -- do not need to mess with tags ever (Expand_Ctrl_Actions flag
- -- is set True in this case).
+ -- and in the class-wide case, the assignment is replaced
+ -- by a dispatching call to _assign. It is suppressed in the
+ -- case of assignments created by the expander that correspond
+ -- to initializations, where we do want to copy the tag
+ -- (Expand_Ctrl_Actions flag is set True in this case). It is
+ -- also suppressed if restriction No_Dispatching_Calls is in
+ -- force because in that case predefined primitives are not
+ -- generated.
or else (Is_Tagged_Type (Typ)
and then not Is_Value_Type (Etype (Lhs))
and then Chars (Current_Scope) /= Name_uAssign
and then Expand_Ctrl_Actions
- and then not Discriminant_Checks_Suppressed (Empty))
+ and then
+ not Restriction_Active (No_Dispatching_Calls))
then
-- Fetch the primitive op _assign and proper type to call it.
-- Because of possible conflicts between private and full view,
--------------------------
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);
+ Isc : constant Node_Id := Iteration_Scheme (N);
+ I_Spec : constant Node_Id := Iterator_Specification (Isc);
+ Id : constant Entity_Id := Defining_Identifier (I_Spec);
+ Loc : constant Source_Ptr := Sloc (N);
- Cursor : Entity_Id;
- New_Loop : Node_Id;
- Stats : List_Id;
+ Container : constant Node_Id := Name (I_Spec);
+ Container_Typ : constant Entity_Id := Etype (Container);
+ Cursor : Entity_Id;
+ New_Loop : Node_Id;
+ Stats : List_Id := Statements (N);
begin
- if Is_Array_Type (Typ) then
+ -- Processing for arrays
+
+ if Is_Array_Type (Container_Typ) then
+
+ -- for Element of Array loop
+ --
+ -- This case requires an internally generated cursor to iterate over
+ -- the array.
+
if Of_Present (I_Spec) then
Cursor := Make_Temporary (Loc, 'C');
- -- for Elem of Arr loop ...
+ -- Generate:
+ -- Element : Component_Type renames Container (Cursor);
- 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);
+ 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 (Cursor, Loc)))));
- 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;
+ -- for Index in Array loop
+ --
+ -- This case utilizes the already given cursor name
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;
- -- Iterators over containers
+ -- Generate:
+ -- for Cursor in [reverse] Container'Range loop
+ -- Element : Component_Type renames Container (Cursor);
+ -- -- for the "of" form
+ --
+ -- <original loop statements>
+ -- end loop;
+
+ 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 => Relocate_Node (Container),
+ Attribute_Name => Name_Range),
+ Reverse_Present => Reverse_Present (I_Spec))),
+ Statements => Stats,
+ End_Label => Empty);
+
+ -- Processing for containers
else
- -- In both cases these require a cursor of the proper type
+ -- The for loop is expanded into a while loop which uses a container
+ -- specific cursor to examine each element.
- -- Cursor : P.Cursor_Type := Container.First;
- -- while Cursor /= P.No_Element loop
+ -- Cursor : Pack.Cursor := Container.First;
+ -- while Cursor /= Pack.No_Element loop
+ -- declare
+ -- -- the block is added when Element_Type is controlled
- -- Obj : P.Element_Type renames Element (Cursor);
- -- -- For the "of" form, the element name renames the element
- -- -- designated by the cursor.
+ -- Obj : Pack.Element_Type := Element (Cursor);
+ -- -- for the "of" loop form
+ -- begin
+ -- <original loop statements>
+ -- end;
- -- Statements;
- -- P.Next (Cursor);
+ -- Pack.Next (Cursor);
-- end loop;
- -- with the obvious replacements if "reverse" is specified.
+ -- If "reverse" is present, then the initialization of the cursor
+ -- uses Last and the step becomes Prev. Pack is the name of the
+ -- package which instantiates the container.
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;
+ Element_Type : constant Entity_Id := Etype (Id);
+ Pack : constant Entity_Id :=
+ Scope (Base_Type (Container_Typ));
+ Decl : Node_Id;
+ Cntr : Node_Id;
+ Name_Init : Name_Id;
+ Name_Step : Name_Id;
begin
- Stats := Statements (N);
+ -- The "of" case uses an internally generated cursor
if Of_Present (I_Spec) then
Cursor := Make_Temporary (Loc, 'C');
Cursor := Id;
end if;
- if Reverse_Present (I_Spec) then
+ -- The code below only handles containers where Element is not a
+ -- primitive operation of the container. This excludes for now the
+ -- Hi-Lite formal containers.
+
+ if Of_Present (I_Spec) then
+
+ -- Generate:
+ -- Id : Element_Type := Pack.Element (Cursor);
+
+ Decl :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Id,
+ Subtype_Mark =>
+ New_Reference_To (Element_Type, Loc),
+ Name =>
+ Make_Indexed_Component (Loc,
+ Prefix =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ New_Reference_To (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Chars => Name_Element)),
+ Expressions => New_List (
+ New_Reference_To (Cursor, Loc))));
+
+ -- When the container holds controlled objects, wrap the loop
+ -- statements and element renaming declaration with a block.
+ -- This ensures that the transient result of Element (Cursor)
+ -- is cleaned up after each iteration of the loop.
+
+ if Needs_Finalization (Element_Type) then
+
+ -- Generate:
+ -- declare
+ -- Id : Element_Type := Pack.Element (Cursor);
+ -- begin
+ -- <original loop statments>
+ -- end;
+
+ Stats := New_List (
+ Make_Block_Statement (Loc,
+ Declarations => New_List (Decl),
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Stats)));
+ else
+ Prepend_To (Stats, Decl);
+ end if;
+ end if;
- -- Must verify that the container has a reverse iterator ???
+ -- Determine the advancement and initialization steps for the
+ -- cursor.
+ -- Must verify that the container has a reverse iterator ???
+
+ if Reverse_Present (I_Spec) then
Name_Init := Name_Last;
Name_Step := Name_Previous;
-
else
Name_Init := Name_First;
Name_Step := Name_Next;
end if;
- -- C : Cursor_Type := Container.First;
+ -- For both iterator forms, add a call to the step operation to
+ -- advance the cursor. Generate:
+ --
+ -- Pack.[Next | Prev] (Cursor);
- 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 =>
+ Append_To (Stats,
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Container, Loc),
- Selector_Name => Make_Identifier (Loc, Name_Init)));
+ Prefix =>
+ New_Reference_To (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_Step)),
- Insert_Action (N, Cursor_Decl);
+ Parameter_Associations => New_List (
+ New_Reference_To (Cursor, Loc))));
- -- while C /= No_Element loop
+ -- Generate:
+ -- while Cursor /= Pack.No_Element loop
+ -- <Stats>
+ -- end 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, Name_No_Element)));
+ New_Loop :=
+ Make_Loop_Statement (Loc,
+ Iteration_Scheme =>
+ Make_Iteration_Scheme (Loc,
+ Condition =>
+ Make_Op_Ne (Loc,
+ Left_Opnd =>
+ New_Reference_To (Cursor, Loc),
+ Right_Opnd =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ New_Reference_To (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_No_Element)))),
+ Statements => Stats,
+ End_Label => Empty);
+
+ Cntr := Relocate_Node (Container);
+
+ -- When the container is provided by a function call, create an
+ -- explicit renaming of the function result. Generate:
+ --
+ -- Cnn : Container_Typ renames Func_Call (...);
+ --
+ -- The renaming avoids the generation of a transient scope when
+ -- initializing the cursor and the premature finalization of the
+ -- container.
+
+ if Nkind (Cntr) = N_Function_Call then
+ declare
+ Ren_Id : constant Entity_Id := Make_Temporary (Loc, 'C');
- if Of_Present (I_Spec) then
+ begin
+ Insert_Action (N,
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Ren_Id,
+ Subtype_Mark =>
+ New_Reference_To (Container_Typ, Loc),
+ Name => Cntr));
+
+ Cntr := New_Reference_To (Ren_Id, Loc);
+ end;
+ end if;
- -- Id : Element_Type renames Pack.Element (Cursor);
+ -- Create the declaration of the cursor and insert it before the
+ -- source loop. Generate:
+ --
+ -- C : Pack.Cursor_Type := Container.[First | Last];
- 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))));
+ Insert_Action (N,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Cursor,
+ Object_Definition =>
+ Make_Selected_Component (Loc,
+ Prefix =>
+ New_Reference_To (Pack, Loc),
+ Selector_Name =>
+ Make_Identifier (Loc, Name_Cursor)),
- Prepend (Renaming_Decl, Stats);
- end if;
+ Expression =>
+ Make_Selected_Component (Loc,
+ Prefix => Cntr,
+ Selector_Name =>
+ Make_Identifier (Loc, Name_Init))));
- -- For both iterator forms, add call to step operation (Next or
- -- Previous) to advance 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.
- 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);
+ if Present (Condition_Actions (Isc)) then
+ Insert_List_Before (N, Condition_Actions (Isc));
+ end if;
end;
end if;
- -- Set_Analyzed (I_Spec);
- -- Why is this commented out???
-
Rewrite (N, New_Loop);
Analyze (N);
end Expand_Iterator_Loop;
elsif Present (Isc)
and then Present (Condition_Actions (Isc))
+ and then Present (Condition (Isc))
then
declare
ES : Node_Id;
OSDN Git Service
