+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
-- 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;
N_Index_Or_Discriminant_Constraint |
N_Indexed_Component |
N_Integer_Literal |
+ N_Iterator_Specification |
N_Itype_Reference |
N_Label |
N_Loop_Parameter_Specification |
-- 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
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;
-- 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
Iter_Scheme_Node : Node_Id;
Loop_For_Flag : Boolean;
Created_Name : Node_Id;
+ Spec : Node_Id;
begin
Push_Scope_Stack;
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
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
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 --
--------------------------
when N_Integer_Literal =>
Analyze_Integer_Literal (N);
+ when N_Iterator_Specification =>
+ Analyze_Iterator_Specification (N);
+
when N_Itype_Reference =>
Analyze_Itype_Reference (N);
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 --
---------------------------
-- 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
-- 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
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
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
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 --
-------------------
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);
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 --
------------
-- 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.
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
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
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
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
(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;
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);
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
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
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
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
(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;
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);
-- 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
-- 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)
--------------------------
-- 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
-- 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)
---------------------------------------
-- 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 --
--------------------------
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,
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
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
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
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
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)
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
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)
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 + $;
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));
projects / platform / upstream / gcc.git / commitdiff