Add predicates on subtypes E and N.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* einfo-utils.ads, einfo-utils.adb: Add predicates on subtypes E
and N. Change some parameters to use the unpredicated subtypes,
because they sometimes return e.g. Empty. Note that N_Entity_Id
has a predicate; Entity_Id does not.
* exp_tss.adb (Base_Init_Proc): Use Entity_Id instead of E,
because otherwise we fail the predicate. We shouldn't be
referring to single-letter names from far away anyway.
* sem_aux.adb (Is_Derived_Type): Likewise.
* sem_res.adb (Is_Definite_Access_Type): Use N_Entity_Id for
predicate.
* types.ads (Entity_Id): Add comment explaining the difference
between Entity_Id and N_Entity_Id.diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -28,7 +28,6 @@ with Elists; use Elists;
with Nlists; use Nlists;
with Output; use Output;
with Sinfo; use Sinfo;
-with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
package body Einfo.Utils is
@@ -307,7 +306,7 @@ package body Einfo.Utils is
return Ekind (Id) in Generic_Unit_Kind;
end Is_Generic_Unit;
- function Is_Ghost_Entity (Id : Entity_Id) return Boolean is
+ function Is_Ghost_Entity (Id : E) return Boolean is
begin
return Is_Checked_Ghost_Entity (Id) or else Is_Ignored_Ghost_Entity (Id);
end Is_Ghost_Entity;
@@ -593,7 +592,7 @@ package body Einfo.Utils is
-- Address_Clause --
--------------------
- function Address_Clause (Id : E) return N is
+ function Address_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Address);
end Address_Clause;
@@ -618,7 +617,7 @@ package body Einfo.Utils is
-- Alignment_Clause --
----------------------
- function Alignment_Clause (Id : E) return N is
+ function Alignment_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Alignment);
end Alignment_Clause;
@@ -672,7 +671,7 @@ package body Einfo.Utils is
-- Declaration_Node --
----------------------
- function Declaration_Node (Id : E) return N is
+ function Declaration_Node (Id : E) return Node_Id is
P : Node_Id;
begin
@@ -771,7 +770,7 @@ package body Einfo.Utils is
-- First_Component --
---------------------
- function First_Component (Id : E) return E is
+ function First_Component (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@@ -793,7 +792,7 @@ package body Einfo.Utils is
-- First_Component_Or_Discriminant --
-------------------------------------
- function First_Component_Or_Discriminant (Id : E) return E is
+ function First_Component_Or_Discriminant (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@@ -816,7 +815,7 @@ package body Einfo.Utils is
-- First_Formal --
------------------
- function First_Formal (Id : E) return E is
+ function First_Formal (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@@ -857,7 +856,7 @@ package body Einfo.Utils is
-- First_Formal_With_Extras --
------------------------------
- function First_Formal_With_Extras (Id : E) return E is
+ function First_Formal_With_Extras (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@@ -1383,7 +1382,7 @@ package body Einfo.Utils is
-- Invariant_Procedure --
-------------------------
- function Invariant_Procedure (Id : E) return E is
+ function Invariant_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@@ -1525,7 +1524,7 @@ package body Einfo.Utils is
-- Is_Elaboration_Target --
---------------------------
- function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
+ function Is_Elaboration_Target (Id : E) return Boolean is
begin
return
Ekind (Id) in E_Constant | E_Package | E_Variable
@@ -1768,7 +1767,7 @@ package body Einfo.Utils is
-- Last_Formal --
-----------------
- function Last_Formal (Id : E) return E is
+ function Last_Formal (Id : E) return Entity_Id is
Formal : Entity_Id;
begin
@@ -1911,7 +1910,7 @@ package body Einfo.Utils is
-- Next_Component --
--------------------
- function Next_Component (Id : E) return E is
+ function Next_Component (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@@ -1928,7 +1927,7 @@ package body Einfo.Utils is
-- Next_Component_Or_Discriminant --
------------------------------------
- function Next_Component_Or_Discriminant (Id : E) return E is
+ function Next_Component_Or_Discriminant (Id : E) return Entity_Id is
Comp_Id : Entity_Id;
begin
@@ -1949,7 +1948,7 @@ package body Einfo.Utils is
-- Next_Stored_Discriminant by making sure that the Discriminant
-- returned is of the same variety as Id.
- function Next_Discriminant (Id : E) return E is
+ function Next_Discriminant (Id : E) return Entity_Id is
-- Derived Tagged types with private extensions look like this...
@@ -1962,7 +1961,7 @@ package body Einfo.Utils is
-- so it is critical not to go past the leading discriminants
- D : E := Id;
+ D : Entity_Id := Id;
begin
pragma Assert (Ekind (Id) = E_Discriminant);
@@ -1987,7 +1986,7 @@ package body Einfo.Utils is
-- Next_Formal --
-----------------
- function Next_Formal (Id : E) return E is
+ function Next_Formal (Id : E) return Entity_Id is
P : Entity_Id;
begin
@@ -2012,7 +2011,7 @@ package body Einfo.Utils is
-- Next_Formal_With_Extras --
-----------------------------
- function Next_Formal_With_Extras (Id : E) return E is
+ function Next_Formal_With_Extras (Id : E) return Entity_Id is
begin
if Present (Extra_Formal (Id)) then
return Extra_Formal (Id);
@@ -2025,7 +2024,7 @@ package body Einfo.Utils is
-- Next_Index --
----------------
- function Next_Index (Id : Node_Id) return Node_Id is
+ function Next_Index (Id : N) return Node_Id is
begin
pragma Assert (Nkind (Id) in N_Is_Index);
pragma Assert (No (Next (Id)) or else Nkind (Next (Id)) in N_Is_Index);
@@ -2036,7 +2035,7 @@ package body Einfo.Utils is
-- Next_Literal --
------------------
- function Next_Literal (Id : E) return E is
+ function Next_Literal (Id : E) return Entity_Id is
begin
pragma Assert (Nkind (Id) in N_Entity);
return Next (Id);
@@ -2046,7 +2045,7 @@ package body Einfo.Utils is
-- Next_Stored_Discriminant --
------------------------------
- function Next_Stored_Discriminant (Id : E) return E is
+ function Next_Stored_Discriminant (Id : E) return Entity_Id is
begin
-- See comment in Next_Discriminant
@@ -2124,7 +2123,7 @@ package body Einfo.Utils is
-- Object_Size_Clause --
------------------------
- function Object_Size_Clause (Id : E) return N is
+ function Object_Size_Clause (Id : E) return Node_Id is
begin
return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size);
end Object_Size_Clause;
@@ -2142,7 +2141,7 @@ package body Einfo.Utils is
-- DIC_Procedure --
-------------------
- function DIC_Procedure (Id : E) return E is
+ function DIC_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@@ -2174,7 +2173,7 @@ package body Einfo.Utils is
return Empty;
end DIC_Procedure;
- function Partial_DIC_Procedure (Id : E) return E is
+ function Partial_DIC_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@@ -2227,7 +2226,7 @@ package body Einfo.Utils is
-- Partial_Invariant_Procedure --
---------------------------------
- function Partial_Invariant_Procedure (Id : E) return E is
+ function Partial_Invariant_Procedure (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@@ -2340,7 +2339,7 @@ package body Einfo.Utils is
-- Predicate_Function --
------------------------
- function Predicate_Function (Id : E) return E is
+ function Predicate_Function (Id : E) return Entity_Id is
Subp_Elmt : Elmt_Id;
Subp_Id : Entity_Id;
Subps : Elist_Id;
@@ -2835,8 +2834,8 @@ package body Einfo.Utils is
-- Size_Clause --
-----------------
- function Size_Clause (Id : E) return N is
- Result : N := Get_Attribute_Definition_Clause (Id, Attribute_Size);
+ function Size_Clause (Id : E) return Node_Id is
+ Result : Node_Id := Get_Attribute_Definition_Clause (Id, Attribute_Size);
begin
if No (Result) then
Result := Get_Attribute_Definition_Clause (Id, Attribute_Value_Size);
@@ -2938,7 +2937,7 @@ package body Einfo.Utils is
-- Type_High_Bound --
---------------------
- function Type_High_Bound (Id : E) return Node_Id is
+ function Type_High_Bound (Id : E) return N is
Rng : constant Node_Id := Scalar_Range (Id);
begin
if Nkind (Rng) = N_Subtype_Indication then
@@ -2952,7 +2951,7 @@ package body Einfo.Utils is
-- Type_Low_Bound --
--------------------
- function Type_Low_Bound (Id : E) return Node_Id is
+ function Type_Low_Bound (Id : E) return N is
Rng : constant Node_Id := Scalar_Range (Id);
begin
if Nkind (Rng) = N_Subtype_Indication then
@@ -2966,7 +2965,7 @@ package body Einfo.Utils is
-- Underlying_Type --
---------------------
- function Underlying_Type (Id : E) return E is
+ function Underlying_Type (Id : E) return Entity_Id is
begin
-- For record_with_private the underlying type is always the direct full
-- view. Never try to take the full view of the parent it does not make
diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads
--- a/gcc/ada/einfo-utils.ads
+++ b/gcc/ada/einfo-utils.ads
@@ -24,6 +24,7 @@
------------------------------------------------------------------------------
with Einfo.Entities; use Einfo.Entities;
+with Sinfo.Nodes; use Sinfo.Nodes;
package Einfo.Utils is
@@ -73,14 +74,16 @@ package Einfo.Utils is
-------------------
-- The following type synonyms are used to tidy up the function and
- -- procedure declarations that follow.
+ -- procedure declarations that follow. Note that E and N have predicates
+ -- ensuring the correct kind; we use Entity_Id or Node_Id when the
+ -- predicates can't be satisfied.
subtype B is Boolean;
subtype C is Component_Alignment_Kind;
- subtype E is Entity_Id;
+ subtype E is N_Entity_Id;
subtype F is Float_Rep_Kind;
subtype M is Mechanism_Type;
- subtype N is Node_Id;
+ subtype N is Node_Id with Predicate => N /= Empty and then N not in E;
subtype U is Uint;
subtype R is Ureal;
subtype L is Elist_Id;
@@ -199,17 +202,17 @@ package Einfo.Utils is
-- The functions in this section synthesize attributes from the tree,
-- so they do not correspond to defined fields in the entity itself.
- function Address_Clause (Id : E) return N;
+ function Address_Clause (Id : E) return Node_Id;
function Aft_Value (Id : E) return U;
- function Alignment_Clause (Id : E) return N;
+ function Alignment_Clause (Id : E) return Node_Id;
function Base_Type (Id : E) return E;
- function Declaration_Node (Id : E) return N;
+ function Declaration_Node (Id : E) return Node_Id;
function Designated_Type (Id : E) return E;
function Entry_Index_Type (Id : E) return E;
- function First_Component (Id : E) return E;
- function First_Component_Or_Discriminant (Id : E) return E;
- function First_Formal (Id : E) return E;
- function First_Formal_With_Extras (Id : E) return E;
+ function First_Component (Id : E) return Entity_Id;
+ function First_Component_Or_Discriminant (Id : E) return Entity_Id;
+ function First_Formal (Id : E) return Entity_Id;
+ function First_Formal_With_Extras (Id : E) return Entity_Id;
function Float_Rep
(N : Entity_Id) return F with Inline, Pre =>
@@ -260,7 +263,7 @@ package Einfo.Utils is
function Is_Task_Interface (Id : E) return B;
function Is_Task_Record_Type (Id : E) return B;
function Is_Wrapper_Package (Id : E) return B;
- function Last_Formal (Id : E) return E;
+ function Last_Formal (Id : E) return Entity_Id;
function Machine_Emax_Value (Id : E) return U;
function Machine_Emin_Value (Id : E) return U;
function Machine_Mantissa_Value (Id : E) return U;
@@ -269,18 +272,18 @@ package Einfo.Utils is
function Model_Epsilon_Value (Id : E) return R;
function Model_Mantissa_Value (Id : E) return U;
function Model_Small_Value (Id : E) return R;
- function Next_Component (Id : E) return E;
- function Next_Component_Or_Discriminant (Id : E) return E;
- function Next_Discriminant (Id : E) return E;
- function Next_Formal (Id : E) return E;
- function Next_Formal_With_Extras (Id : E) return E;
- function Next_Index (Id : N) return N;
- function Next_Literal (Id : E) return E;
- function Next_Stored_Discriminant (Id : E) return E;
+ function Next_Component (Id : E) return Entity_Id;
+ function Next_Component_Or_Discriminant (Id : E) return Entity_Id;
+ function Next_Discriminant (Id : E) return Entity_Id;
+ function Next_Formal (Id : E) return Entity_Id;
+ function Next_Formal_With_Extras (Id : E) return Entity_Id;
+ function Next_Index (Id : N) return Node_Id;
+ function Next_Literal (Id : E) return Entity_Id;
+ function Next_Stored_Discriminant (Id : E) return Entity_Id;
function Number_Dimensions (Id : E) return Pos;
function Number_Entries (Id : E) return Nat;
function Number_Formals (Id : E) return Pos;
- function Object_Size_Clause (Id : E) return N;
+ function Object_Size_Clause (Id : E) return Node_Id;
function Parameter_Mode (Id : E) return Formal_Kind;
function Partial_Refinement_Constituents (Id : E) return L;
function Primitive_Operations (Id : E) return L;
@@ -288,11 +291,11 @@ package Einfo.Utils is
function Safe_Emax_Value (Id : E) return U;
function Safe_First_Value (Id : E) return R;
function Safe_Last_Value (Id : E) return R;
- function Size_Clause (Id : E) return N;
+ function Size_Clause (Id : E) return Node_Id;
function Stream_Size_Clause (Id : E) return N;
function Type_High_Bound (Id : E) return N;
function Type_Low_Bound (Id : E) return N;
- function Underlying_Type (Id : E) return E;
+ function Underlying_Type (Id : E) return Entity_Id;
function Scope_Depth (Id : E) return U;
function Scope_Depth_Set (Id : E) return B;
@@ -432,11 +435,11 @@ package Einfo.Utils is
function Is_Partial_DIC_Procedure (Id : E) return B;
- function DIC_Procedure (Id : E) return E;
- function Partial_DIC_Procedure (Id : E) return E;
- function Invariant_Procedure (Id : E) return E;
- function Partial_Invariant_Procedure (Id : E) return E;
- function Predicate_Function (Id : E) return E;
+ function DIC_Procedure (Id : E) return Entity_Id;
+ function Partial_DIC_Procedure (Id : E) return Entity_Id;
+ function Invariant_Procedure (Id : E) return Entity_Id;
+ function Partial_Invariant_Procedure (Id : E) return Entity_Id;
+ function Predicate_Function (Id : E) return Entity_Id;
procedure Set_DIC_Procedure (Id : E; V : E);
procedure Set_Partial_DIC_Procedure (Id : E; V : E);
diff --git a/gcc/ada/exp_tss.adb b/gcc/ada/exp_tss.adb
--- a/gcc/ada/exp_tss.adb
+++ b/gcc/ada/exp_tss.adb
@@ -49,7 +49,7 @@ package body Exp_Tss is
(Typ : Entity_Id;
Ref : Entity_Id := Empty) return Entity_Id
is
- Full_Type : E;
+ Full_Type : Entity_Id;
Proc : Entity_Id;
begin
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -964,7 +964,7 @@ package body Sem_Aux is
-- Is_Derived_Type --
---------------------
- function Is_Derived_Type (Ent : E) return B is
+ function Is_Derived_Type (Ent : Entity_Id) return B is
Par : Node_Id;
begin
@@ -1130,10 +1130,8 @@ package body Sem_Aux is
else
declare
- C : E;
-
+ C : Entity_Id := First_Component (Btype);
begin
- C := First_Component (Btype);
while Present (C) loop
if Is_Limited_Type (Etype (C)) then
return True;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -144,7 +144,7 @@ package body Sem_Res is
-- returns true if the prefix denotes an atomic object that has an address
-- clause (the case in which we may want to issue a warning).
- function Is_Definite_Access_Type (E : Entity_Id) return Boolean;
+ function Is_Definite_Access_Type (E : N_Entity_Id) return Boolean;
-- Determine whether E is an access type declared by an access declaration,
-- and not an (anonymous) allocator type.
@@ -1510,7 +1510,7 @@ package body Sem_Res is
-- Is_Definite_Access_Type --
-----------------------------
- function Is_Definite_Access_Type (E : Entity_Id) return Boolean is
+ function Is_Definite_Access_Type (E : N_Entity_Id) return Boolean is
Btyp : constant Entity_Id := Base_Type (E);
begin
return Ekind (Btyp) = E_Access_Type
@@ -1561,7 +1561,7 @@ package body Sem_Res is
Orig_Type : Entity_Id := Empty;
Pack : Entity_Id;
- type Kind_Test is access function (E : Entity_Id) return Boolean;
+ type Kind_Test is access function (E : N_Entity_Id) return Boolean;
function Operand_Type_In_Scope (S : Entity_Id) return Boolean;
-- If the operand is not universal, and the operator is given by an
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -404,6 +404,11 @@ package Types is
-- that are entities (i.e. nodes with an Nkind of N_Defining_xxx). All such
-- nodes are extended nodes and these are the only extended nodes, so that
-- in practice entity and extended nodes are synonymous.
+ --
+ -- Note that Sinfo.Nodes.N_Entity_Id is the same as Entity_Id, except it
+ -- has a predicate requiring the correct Nkind. Opt_N_Entity_Id is the same
+ -- as N_Entity_Id, except it allows Empty. (Sinfo.Nodes is generated by the
+ -- Gen_IL program.)
subtype Node_Or_Entity_Id is Node_Id;
-- A synonym for node types, used in cases where a given value may be used
