aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2010-10-22 11:36:41 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2010-10-22 11:36:41 +0200
commit57d62f0cb7346e2a76e7e70c3b3726d0140ec662 (patch)
treeb51589b3c1031d88407ce19e8674a52d97c3acfa
parentc3ad80f0001bc349f484f576576997984f7aa1ff (diff)
downloadgcc-57d62f0cb7346e2a76e7e70c3b3726d0140ec662.zip
gcc-57d62f0cb7346e2a76e7e70c3b3726d0140ec662.tar.gz
gcc-57d62f0cb7346e2a76e7e70c3b3726d0140ec662.tar.bz2
[multiple changes]
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
-rw-r--r--gcc/ada/ChangeLog24
-rw-r--r--gcc/ada/exp_ch5.adb207
-rw-r--r--gcc/ada/exp_util.adb1
-rw-r--r--gcc/ada/par-ch4.adb11
-rw-r--r--gcc/ada/par-ch5.adb69
-rw-r--r--gcc/ada/sem.adb3
-rwxr-xr-xgcc/ada/sem_aux.adb19
-rwxr-xr-xgcc/ada/sem_aux.ads5
-rw-r--r--gcc/ada/sem_ch5.adb99
-rw-r--r--gcc/ada/sem_ch5.ads1
-rw-r--r--gcc/ada/sem_util.adb19
-rw-r--r--gcc/ada/sem_util.ads5
-rw-r--r--gcc/ada/sinfo.adb42
-rw-r--r--gcc/ada/sinfo.ads52
-rw-r--r--gcc/ada/snames.ads-tmpl8
-rw-r--r--gcc/ada/sprint.adb27
16 files changed, 557 insertions, 35 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ffaef4e..04e8a0e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 6694fdf..48e6238 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 1ce017b..3a94bef 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 a613e1f..8ab04ef 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 15e290e..e6f28c9 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 42447c2..9a9809c 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 ee23d17..f19ead7 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 8ef11ec..25f95ab 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 64db520..a303807 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 48e9764..fdf09db 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 d53e483..109ee58 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 94786a1..be4987b 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 dd09e4c..fe6bf81 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 f47892a..2b145cc 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 29cc172..91f50e4 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 e2bb173..627fb2f 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));