+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
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;
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;
-------------------------------------
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;
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;
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;
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
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;
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;
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);
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
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 --
---------------------------
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
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
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
-- 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
-- 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
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
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
(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 =>
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);
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);
projects / thirdparty / gcc.git / commitdiff
