+ ----------------------------
+ -- Try_Container_Indexing --
+ ----------------------------
+
+ function Try_Container_Indexing
+ (N : Node_Id;
+ Prefix : Node_Id;
+ Expr : Node_Id) return Boolean
+ is
+ Loc : constant Source_Ptr := Sloc (N);
+ Disc : Entity_Id;
+ Func : Entity_Id;
+ Func_Name : Node_Id;
+ Indexing : Node_Id;
+
+ begin
+
+ -- Check whether type has a specified indexing aspect
+
+ Func_Name := Empty;
+
+ if Is_Variable (Prefix) then
+ Func_Name := Find_Aspect (Etype (Prefix), Aspect_Variable_Indexing);
+ end if;
+
+ if No (Func_Name) then
+ Func_Name := Find_Aspect (Etype (Prefix), Aspect_Constant_Indexing);
+ end if;
+
+ -- If aspect does not exist the expression is illegal. Error is
+ -- diagnosed in caller.
+
+ if No (Func_Name) then
+
+ -- The prefix itself may be an indexing of a container
+ -- rewrite as such and re-analyze.
+
+ if Has_Implicit_Dereference (Etype (Prefix)) then
+ Build_Explicit_Dereference
+ (Prefix, First_Discriminant (Etype (Prefix)));
+ return Try_Container_Indexing (N, Prefix, Expr);
+
+ else
+ return False;
+ end if;
+ end if;
+
+ if not Is_Overloaded (Func_Name) then
+ Func := Entity (Func_Name);
+ Indexing := Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Func, Loc),
+ Parameter_Associations =>
+ New_List (Relocate_Node (Prefix), Relocate_Node (Expr)));
+ Rewrite (N, Indexing);
+ Analyze (N);
+
+ -- 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.
+
+ 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;
+
+ Next_Discriminant (Disc);
+ end loop;
+ end if;
+
+ else
+ Indexing := Make_Function_Call (Loc,
+ Name => Make_Identifier (Loc, Chars (Func_Name)),
+ Parameter_Associations =>
+ New_List (Relocate_Node (Prefix), Relocate_Node (Expr)));
+
+ Rewrite (N, Indexing);
+
+ declare
+ I : Interp_Index;
+ It : Interp;
+ Success : Boolean;
+
+ begin
+ Get_First_Interp (Func_Name, I, It);
+ Set_Etype (N, Any_Type);
+ while Present (It.Nam) loop
+ Analyze_One_Call (N, It.Nam, False, Success);
+ if Success then
+ Set_Etype (Name (N), It.Typ);
+ Set_Entity (Name (N), It.Nam);
+
+ -- Add implicit dereference interpretation
+
+ if Has_Discriminants (Etype (It.Nam)) then
+ Disc := First_Discriminant (Etype (It.Nam));
+ while Present (Disc) loop
+ if Has_Implicit_Dereference (Disc) then
+ Add_One_Interp
+ (N, Disc, Designated_Type (Etype (Disc)));
+ exit;
+ end if;
+
+ Next_Discriminant (Disc);
+ end loop;
+ end if;
+
+ exit;
+ end if;
+ Get_Next_Interp (I, It);
+ end loop;
+ end;
+ end if;
+
+ if Etype (N) = Any_Type then
+ Error_Msg_NE ("container cannot be indexed with&", N, Etype (Expr));
+ Rewrite (N, New_Occurrence_Of (Any_Id, Loc));
+ else
+ Analyze (N);
+ end if;
+
+ return True;
+ end Try_Container_Indexing;
+