This patch introduces a new semantic attribute Generalized_Indexing, for
indexed_components that are instances of Ada 2012 container indexing operations.
Analysis and resolution of such nodes is performed on the attribute, and the
original source is preserved for ASIS operations. If expansion is enabled, the
indexed component is replaced by the value of this attribute, which is in a
call to an Indexing aspect, in most case wrapped in a dereference operation.
Otherwise the original node is type-annotated, which makes ASIS queries and
pretty-printing simpler.
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-02-24 Ed Schonberg <schonb...@adacore.com>
* sinfo.ads, sinfo.adb: New attribute Generalized_Indexing, for
indexed_components that are instances of Ada 2012 container
indexing operations. Analysis and resolution of such nodes
is performed on the attribute, and the original source is
preserved for ASIS operations. If expansion is enabled, the
indexed component is replaced by the value of this attribute,
which is in a call to an Indexing aspect, in most case wrapped
in a dereference operation.
* sem_ch4.adb (Analyze_Indexed_Component): Create
Generalized_Indexing attribute when appropriate.
(Analyze_Call): If prefix is not overloadable and has an indexing
aspect, transform into an indexed component so it can be analyzed
as a potential container indexing.
(Analyze_Expression): If node is an indexed component with a
Generalized_ Indexing, do not re-analyze.
* sem_res.adb (Resolve_Generalized_Indexing): Complete resolution
of an indexed_component that has been transformed into a container
indexing operation.
(Resolve_Indexed_Component): Call the above when required.
(Resolve): Do not insert an explicit dereference operation on
an indexed_component whose type has an implicit dereference:
the operation is inserted when resolving the related
Generalized_Indexing.
Index: sinfo.adb
===================================================================
--- sinfo.adb (revision 208067)
+++ sinfo.adb (working copy)
@@ -1399,6 +1399,14 @@
return Flag6 (N);
end From_Default;
+ function Generalized_Indexing
+ (N : Node_Id) return Node_Id is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Indexed_Component);
+ return Node4 (N);
+ end Generalized_Indexing;
+
function Generic_Associations
(N : Node_Id) return List_Id is
begin
@@ -4531,6 +4539,14 @@
Set_Flag6 (N, Val);
end Set_From_Default;
+ procedure Set_Generalized_Indexing
+ (N : Node_Id; Val : Node_Id) is
+ begin
+ pragma Assert (False
+ or else NT (N).Nkind = N_Indexed_Component);
+ Set_Node4 (N, Val);
+ end Set_Generalized_Indexing;
+
procedure Set_Generic_Associations
(N : Node_Id; Val : List_Id) is
begin
Index: sinfo.ads
===================================================================
--- sinfo.ads (revision 208067)
+++ sinfo.ads (working copy)
@@ -1277,6 +1277,15 @@
-- declaration is treated as an implicit reference to the formal in the
-- ali file.
+ -- Generalized_Indexing (Node4-Sem)
+ -- Generalized_Indexing is set in Indexed_Component nodes that are Ada 2012
+ -- container indexing operations. The value of the attribute is a function
+ -- call (possibly dereferenced) that corresponds to the proper expansion
+ -- of the source indexing operation. Before expansion, the source node
+ -- is rewritten as the resolved generalized indexing. In ASIS mode, the
+ -- expansion does not take place, so that the source is preserved and
+ -- properly annotated with types.
+
-- Generic_Parent (Node5-Sem)
-- Generic_Parent is defined on declaration nodes that are instances. The
-- value of Generic_Parent is the generic entity from which the instance
@@ -3470,6 +3479,7 @@
-- Sloc contains a copy of the Sloc value of the Prefix
-- Prefix (Node3)
-- Expressions (List1)
+ -- Generalized_Indexing (Node4-Sem)
-- Atomic_Sync_Required (Flag14-Sem)
-- plus fields for expression
@@ -8912,6 +8922,8 @@
function From_Default
(N : Node_Id) return Boolean; -- Flag6
+ function Generalized_Indexing
+ (N : Node_Id) return Node_Id; -- Node4
function Generic_Associations
(N : Node_Id) return List_Id; -- List3
@@ -9908,6 +9920,9 @@
procedure Set_From_Default
(N : Node_Id; Val : Boolean := True); -- Flag6
+ procedure Set_Generalized_Indexing
+ (N : Node_Id; Val : Node_Id); -- Node4
+
procedure Set_Generic_Associations
(N : Node_Id; Val : List_Id); -- List3
@@ -10918,7 +10933,7 @@
(1 => True, -- Expressions (List1)
2 => False, -- unused
3 => True, -- Prefix (Node3)
- 4 => False, -- unused
+ 4 => False, -- Generalized_Indexing (Node4-Sem)
5 => False), -- Etype (Node5-Sem)
N_Slice =>
@@ -12372,6 +12387,7 @@
pragma Inline (From_At_End);
pragma Inline (From_At_Mod);
pragma Inline (From_Default);
+ pragma Inline (Generalized_Indexing);
pragma Inline (Generic_Associations);
pragma Inline (Generic_Formal_Declarations);
pragma Inline (Generic_Parent);
@@ -12701,6 +12717,7 @@
pragma Inline (Set_From_At_End);
pragma Inline (Set_From_At_Mod);
pragma Inline (Set_From_Default);
+ pragma Inline (Set_Generalized_Indexing);
pragma Inline (Set_Generic_Associations);
pragma Inline (Set_Generic_Formal_Declarations);
pragma Inline (Set_Generic_Parent);
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 208070)
+++ sem_res.adb (working copy)
@@ -174,6 +174,7 @@
procedure Resolve_Explicit_Dereference (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Expression_With_Actions (N : Node_Id; Typ : Entity_Id);
procedure Resolve_If_Expression (N : Node_Id; Typ : Entity_Id);
+ procedure Resolve_Generalized_Indexing (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Indexed_Component (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Integer_Literal (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Logical_Op (N : Node_Id; Typ : Entity_Id);
@@ -2375,8 +2376,16 @@
and then Ekind (It.Nam) = E_Discriminant
and then Has_Implicit_Dereference (It.Nam)
then
- Build_Explicit_Dereference (N, It.Nam);
+ -- If the node is a general indexing, the dereference is
+ -- is inserted when resolving the rewritten form, else
+ -- insert it now.
+ if Nkind (N) /= N_Indexed_Component
+ or else No (Generalized_Indexing (N))
+ then
+ Build_Explicit_Dereference (N, It.Nam);
+ end if;
+
-- For an explicit dereference, attribute reference, range,
-- short-circuit form (which is not an operator node), or call
-- with a name that is an explicit dereference, there is
@@ -7520,6 +7529,47 @@
end if;
end Resolve_Expression_With_Actions;
+ ----------------------------------
+ -- Resolve_Generalized_Indexing --
+ ----------------------------------
+
+ procedure Resolve_Generalized_Indexing (N : Node_Id; Typ : Entity_Id) is
+ Indexing : constant Node_Id := Generalized_Indexing (N);
+ Call : Node_Id;
+ Indices : List_Id;
+ Pref : Node_Id;
+
+ begin
+
+ -- In ASIS mode, propagate the information about the indices back to
+ -- to the original indexing node. The generalized indexing is either
+ -- a function call, or a dereference of one. The actuals include the
+ -- prefix of the original node, which is the container expression.
+
+ if ASIS_Mode then
+ Resolve (Indexing, Typ);
+ Set_Etype (N, Etype (Indexing));
+ Set_Is_Overloaded (N, False);
+ Call := Indexing;
+ while Nkind_In (Call,
+ N_Explicit_Dereference, N_Selected_Component)
+ loop
+ Call := Prefix (Call);
+ end loop;
+
+ if Nkind (Call) = N_Function_Call then
+ Indices := Parameter_Associations (Call);
+ Pref := Remove_Head (Indices);
+ Set_Expressions (N, Indices);
+ Set_Prefix (N, Pref);
+ end if;
+
+ else
+ Rewrite (N, Indexing);
+ Resolve (N, Typ);
+ end if;
+ end Resolve_Generalized_Indexing;
+
---------------------------
-- Resolve_If_Expression --
---------------------------
@@ -7591,6 +7641,11 @@
Index : Node_Id;
begin
+ if Present (Generalized_Indexing (N)) then
+ Resolve_Generalized_Indexing (N, Typ);
+ return;
+ end if;
+
if Is_Overloaded (Name) then
-- Use the context type to select the prefix that yields the correct
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 208067)
+++ sem_ch4.adb (working copy)
@@ -1089,10 +1089,29 @@
else
Nam_Ent := Entity (Nam);
- -- If no interpretations, give error message
+ -- If not overloadable, this may be a generalized indexing
+ -- operation with named associations. Rewrite again as an
+ -- indexed component and analyze as container indexing.
if not Is_Overloadable (Nam_Ent) then
- No_Interpretation;
+ if Present (
+ Find_Value_Of_Aspect
+ (Etype (Nam_Ent), Aspect_Constant_Indexing))
+ then
+ Replace (N,
+ Make_Indexed_Component (Sloc (N),
+ Prefix => Nam,
+ Expressions => Parameter_Associations (N)));
+
+ if Try_Container_Indexing (N, Nam, Expressions (N)) then
+ return;
+ else
+ No_Interpretation;
+ end if;
+
+ else
+ No_Interpretation;
+ end if;
return;
end if;
end if;
@@ -1991,8 +2010,19 @@
procedure Analyze_Expression (N : Node_Id) is
begin
- Analyze (N);
- Check_Parameterless_Call (N);
+
+ -- If the expression is an indexed component that will be rewritten
+ -- as a container indexing, it has already been analyzed.
+
+ if Nkind (N) = N_Indexed_Component
+ and then Present (Generalized_Indexing (N))
+ then
+ null;
+
+ else
+ Analyze (N);
+ Check_Parameterless_Call (N);
+ end if;
end Analyze_Expression;
-------------------------------------
@@ -6993,8 +7023,15 @@
Assoc := New_List (Relocate_Node (Prefix));
- -- A generalized iterator may have nore than one index expression, so
+ -- A generalized indexing may have nore than one index expression, so
-- transfer all of them to the argument list to be used in the call.
+ -- Note that there may be named associations, in which case the node
+ -- was rewritten earlier as a call, and has been transformed back into
+ -- an indexed expression to share the following processing.
+ -- The generalized indexing node is the one on which analysis and
+ -- resolution take place. Before expansion the original node is replaced
+ -- with the generalized indexing node, which is a call, possibly with
+ -- a dereference operation.
declare
Arg : Node_Id;
@@ -7012,22 +7049,32 @@
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Func, Loc),
Parameter_Associations => Assoc);
- Rewrite (N, Indexing);
- Analyze (N);
+ Set_Parent (Indexing, Parent (N));
+ Set_Generalized_Indexing (N, Indexing);
+ Analyze (Indexing);
+ Set_Etype (N, Etype (Indexing));
-- If the return type of the indexing function is a reference type,
-- add the dereference as a possible interpretation. Note that the
-- indexing aspect may be a function that returns the element type
- -- with no intervening implicit dereference.
+ -- with no intervening implicit dereference, and that the reference
+ -- discriminant is not the first discriminant.
if Has_Discriminants (Etype (Func)) then
Disc := First_Discriminant (Etype (Func));
while Present (Disc) loop
- if Has_Implicit_Dereference (Disc) then
- Add_One_Interp (N, Disc, Designated_Type (Etype (Disc)));
- exit;
- end if;
+ declare
+ Elmt_Type : Entity_Id;
+ begin
+ if Has_Implicit_Dereference (Disc) then
+ Elmt_Type := Designated_Type (Etype (Disc));
+ Add_One_Interp (Indexing, Disc, Elmt_Type);
+ Add_One_Interp (N, Disc, Elmt_Type);
+ exit;
+ end if;
+ end;
+
Next_Discriminant (Disc);
end loop;
end if;
@@ -7038,7 +7085,8 @@
Name => Make_Identifier (Loc, Chars (Func_Name)),
Parameter_Associations => Assoc);
- Rewrite (N, Indexing);
+ Set_Parent (Indexing, Parent (N));
+ Set_Generalized_Indexing (N, Indexing);
declare
I : Interp_Index;
@@ -7047,12 +7095,13 @@
begin
Get_First_Interp (Func_Name, I, It);
- Set_Etype (N, Any_Type);
+ Set_Etype (Indexing, Any_Type);
while Present (It.Nam) loop
- Analyze_One_Call (N, It.Nam, False, Success);
+ Analyze_One_Call (Indexing, It.Nam, False, Success);
if Success then
- Set_Etype (Name (N), It.Typ);
- Set_Entity (Name (N), It.Nam);
+ Set_Etype (Name (Indexing), It.Typ);
+ Set_Entity (Name (Indexing), It.Nam);
+ Set_Etype (N, Etype (Indexing));
-- Add implicit dereference interpretation
@@ -7061,6 +7110,8 @@
while Present (Disc) loop
if Has_Implicit_Dereference (Disc) then
Add_One_Interp
+ (Indexing, Disc, Designated_Type (Etype (Disc)));
+ Add_One_Interp
(N, Disc, Designated_Type (Etype (Disc)));
exit;
end if;
@@ -7076,12 +7127,10 @@
end;
end if;
- if Etype (N) = Any_Type then
+ if Etype (Indexing) = Any_Type then
Error_Msg_NE
("container cannot be indexed with&", N, Etype (First (Exprs)));
Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
- else
- Analyze (N);
end if;
return True;
