mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-22 11:41:07 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2010-10-22  Robert Dewar  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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
This commit is contained in:
Arnaud Charlet 2010-10-22 11:36:41 +02:00
parent c3ad80f000
commit 57d62f0cb7
16 changed files with 557 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gcc/ada/ChangeLog
View File

@ -1,3 +1,27 @@
2010-10-22 Robert Dewar <dewar@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <quinot@adacore.com>
* sem_prag.adb, sem_ch12.adb, sem_util.adb, sem_util.ads

207
gcc/ada/exp_ch5.adb
View File

@ -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;

1
gcc/ada/exp_util.adb
View File

@ -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 |

11
gcc/ada/par-ch4.adb
View File

@ -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;

69
gcc/ada/par-ch5.adb
View File

@ -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 --
--------------------------

3
gcc/ada/sem.adb
View File

@ -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);

19
gcc/ada/sem_aux.adb
View File

@ -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 --
---------------------------

5
gcc/ada/sem_aux.ads
View File

@ -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

99
gcc/ada/sem_ch5.adb
View File

@ -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 --
-------------------

1
gcc/ada/sem_ch5.ads
View File

@ -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);

19
gcc/ada/sem_util.adb
View File

@ -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 --
------------

5
gcc/ada/sem_util.ads
View File

@ -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.

42
gcc/ada/sinfo.adb
View File

@ -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);

52
gcc/ada/sinfo.ads
View File

@ -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)

8
gcc/ada/snames.ads-tmpl
View File

@ -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 + $;

27
gcc/ada/sprint.adb
View File

@ -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));