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

sinfo.ads, sinfo.adb: New attribute Generalized_Indexing...

Browse Source 
2014-02-24  Ed Schonberg  <schonberg@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.

From-SVN: r208074
This commit is contained in:
Ed Schonberg 2014-02-24 15:57:59 +00:00 committed by Arnaud Charlet
parent ec4e8e9a4d
commit 5f50020ac1
5 changed files with 185 additions and 22 deletions

26
gcc/ada/ChangeLog

@ -1,3 +1,29 @@
2014-02-24 Ed Schonberg <schonberg@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.
2014-02-24 Olivier Ramonat <ramonat@adacore.com>
* gnat_rm.texi, gnat_ugn.texi: Replace Ada Compiler by Ada Development

89
gcc/ada/sem_ch4.adb

@ -1089,10 +1089,29 @@ package body Sem_Ch4 is
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 @@ package body Sem_Ch4 is
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 @@ package body Sem_Ch4 is
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,21 +7049,31 @@ package body Sem_Ch4 is
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;
@ -7038,7 +7085,8 @@ package body Sem_Ch4 is
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 @@ package body Sem_Ch4 is
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
@ -7060,6 +7109,8 @@ package body Sem_Ch4 is
Disc := First_Discriminant (Etype (It.Nam));
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;
@ -7076,12 +7127,10 @@ package body Sem_Ch4 is
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;

57
gcc/ada/sem_res.adb

@ -174,6 +174,7 @@ package body Sem_Res is
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,7 +2376,15 @@ package body Sem_Res is
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
@ -7520,6 +7529,47 @@ package body Sem_Res is
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 @@ package body Sem_Res is
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

16
gcc/ada/sinfo.adb

@ -1399,6 +1399,14 @@ package body Sinfo is
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 @@ package body Sinfo is
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

19
gcc/ada/sinfo.ads

@ -1277,6 +1277,15 @@ package Sinfo is
-- 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 @@ package Sinfo is
-- 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 @@ package Sinfo is
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 @@ package Sinfo is
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 @@ package Sinfo is
(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 @@ package Sinfo is
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 @@ package Sinfo is
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);