|
|
|
@ -559,9 +559,7 @@ package body Einfo is
|
|
|
|
|
function Actual_Subtype (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable
|
|
|
|
|
or else Ekind (Id) = E_Generic_In_Out_Parameter
|
|
|
|
|
(Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
|
|
|
|
|
or else Is_Formal (Id));
|
|
|
|
|
return Node17 (Id);
|
|
|
|
|
end Actual_Subtype;
|
|
|
|
@ -582,10 +580,10 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Is_Type (Id)
|
|
|
|
|
or else Is_Formal (Id)
|
|
|
|
|
or else Ekind (Id) = E_Loop_Parameter
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Exception
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
or else Ekind_In (Id, E_Loop_Parameter,
|
|
|
|
|
E_Constant,
|
|
|
|
|
E_Exception,
|
|
|
|
|
E_Variable));
|
|
|
|
|
return Uint14 (Id);
|
|
|
|
|
end Alignment;
|
|
|
|
|
|
|
|
|
@ -626,8 +624,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Body_Entity (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
|
|
|
|
|
return Node19 (Id);
|
|
|
|
|
end Body_Entity;
|
|
|
|
|
|
|
|
|
@ -664,24 +661,19 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Cloned_Subtype (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Record_Subtype
|
|
|
|
|
or else
|
|
|
|
|
Ekind (Id) = E_Class_Wide_Subtype);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
|
|
|
|
|
return Node16 (Id);
|
|
|
|
|
end Cloned_Subtype;
|
|
|
|
|
|
|
|
|
|
function Component_Bit_Offset (Id : E) return U is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
return Uint11 (Id);
|
|
|
|
|
end Component_Bit_Offset;
|
|
|
|
|
|
|
|
|
|
function Component_Clause (Id : E) return N is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
return Node13 (Id);
|
|
|
|
|
end Component_Clause;
|
|
|
|
|
|
|
|
|
@ -875,17 +867,14 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function DT_Position (Id : E) return U is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
((Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure)
|
|
|
|
|
and then Present (DTC_Entity (Id)));
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
|
|
|
|
|
and then Present (DTC_Entity (Id)));
|
|
|
|
|
return Uint15 (Id);
|
|
|
|
|
end DT_Position;
|
|
|
|
|
|
|
|
|
|
function DTC_Entity (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
return Node16 (Id);
|
|
|
|
|
end DTC_Entity;
|
|
|
|
|
|
|
|
|
@ -986,11 +975,11 @@ package body Einfo is
|
|
|
|
|
function Equivalent_Type (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Class_Wide_Subtype or else
|
|
|
|
|
Ekind (Id) = E_Access_Protected_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Access_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Exception_Type);
|
|
|
|
|
(Ekind_In (Id, E_Class_Wide_Subtype,
|
|
|
|
|
E_Access_Protected_Subprogram_Type,
|
|
|
|
|
E_Anonymous_Access_Protected_Subprogram_Type,
|
|
|
|
|
E_Access_Subprogram_Type,
|
|
|
|
|
E_Exception_Type));
|
|
|
|
|
return Node18 (Id);
|
|
|
|
|
end Equivalent_Type;
|
|
|
|
|
|
|
|
|
@ -1026,9 +1015,9 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Body
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type);
|
|
|
|
|
or else Ekind_In (Id, E_Entry_Family,
|
|
|
|
|
E_Subprogram_Body,
|
|
|
|
|
E_Subprogram_Type));
|
|
|
|
|
return Node28 (Id);
|
|
|
|
|
end Extra_Formals;
|
|
|
|
|
|
|
|
|
@ -1074,15 +1063,13 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function First_Optional_Parameter (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
return Node14 (Id);
|
|
|
|
|
end First_Optional_Parameter;
|
|
|
|
|
|
|
|
|
|
function First_Private_Entity (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Package
|
|
|
|
|
or else Ekind (Id) = E_Generic_Package
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
|
|
|
|
|
or else Ekind (Id) in Concurrent_Kind);
|
|
|
|
|
return Node16 (Id);
|
|
|
|
|
end First_Private_Entity;
|
|
|
|
@ -1278,8 +1265,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Has_Missing_Return (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
|
|
|
|
|
return Flag142 (Id);
|
|
|
|
|
end Has_Missing_Return;
|
|
|
|
|
|
|
|
|
@ -1499,9 +1485,7 @@ package body Einfo is
|
|
|
|
|
function Has_Up_Level_Access (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Variable
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Loop_Parameter);
|
|
|
|
|
(Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
|
|
|
|
|
return Flag215 (Id);
|
|
|
|
|
end Has_Up_Level_Access;
|
|
|
|
|
|
|
|
|
@ -1528,9 +1512,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Implemented_By_Entry (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
return Flag232 (Id);
|
|
|
|
|
end Implemented_By_Entry;
|
|
|
|
|
|
|
|
|
@ -1615,8 +1597,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Asynchronous (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Procedure or else Is_Type (Id));
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Procedure or else Is_Type (Id));
|
|
|
|
|
return Flag81 (Id);
|
|
|
|
|
end Is_Asynchronous;
|
|
|
|
|
|
|
|
|
@ -1632,8 +1613,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Called (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
|
|
|
|
|
return Flag102 (Id);
|
|
|
|
|
end Is_Called;
|
|
|
|
|
|
|
|
|
@ -1744,10 +1724,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_For_Access_Subtype (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Record_Subtype
|
|
|
|
|
or else
|
|
|
|
|
Ekind (Id) = E_Private_Subtype);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
|
|
|
|
|
return Flag118 (Id);
|
|
|
|
|
end Is_For_Access_Subtype;
|
|
|
|
|
|
|
|
|
@ -1937,15 +1914,13 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Generic_Function
|
|
|
|
|
or else Ekind (Id) = E_Generic_Procedure);
|
|
|
|
|
or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
|
|
|
|
|
return Flag218 (Id);
|
|
|
|
|
end Is_Primitive;
|
|
|
|
|
|
|
|
|
|
function Is_Primitive_Wrapper (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
return Flag195 (Id);
|
|
|
|
|
end Is_Primitive_Wrapper;
|
|
|
|
|
|
|
|
|
@ -1962,8 +1937,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Private_Primitive (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
return Flag245 (Id);
|
|
|
|
|
end Is_Private_Primitive;
|
|
|
|
|
|
|
|
|
@ -2231,8 +2205,7 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family);
|
|
|
|
|
or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
|
|
|
|
|
return Flag22 (Id);
|
|
|
|
|
end Needs_No_Actuals;
|
|
|
|
|
|
|
|
|
@ -2283,22 +2256,19 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Normalized_First_Bit (Id : E) return U is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
return Uint8 (Id);
|
|
|
|
|
end Normalized_First_Bit;
|
|
|
|
|
|
|
|
|
|
function Normalized_Position (Id : E) return U is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
return Uint14 (Id);
|
|
|
|
|
end Normalized_Position;
|
|
|
|
|
|
|
|
|
|
function Normalized_Position_Max (Id : E) return U is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
return Uint10 (Id);
|
|
|
|
|
end Normalized_Position_Max;
|
|
|
|
|
|
|
|
|
@ -2317,18 +2287,14 @@ package body Einfo is
|
|
|
|
|
function Optimize_Alignment_Space (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
(Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
return Flag241 (Id);
|
|
|
|
|
end Optimize_Alignment_Space;
|
|
|
|
|
|
|
|
|
|
function Optimize_Alignment_Time (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
(Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
return Flag242 (Id);
|
|
|
|
|
end Optimize_Alignment_Time;
|
|
|
|
|
|
|
|
|
@ -2340,10 +2306,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Original_Record_Component (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Void
|
|
|
|
|
or else Ekind (Id) = E_Component
|
|
|
|
|
or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
|
|
|
|
|
return Node22 (Id);
|
|
|
|
|
end Original_Record_Component;
|
|
|
|
|
|
|
|
|
@ -2359,10 +2322,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Package_Instantiation (Id : E) return N is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(False
|
|
|
|
|
or else Ekind (Id) = E_Generic_Package
|
|
|
|
|
or else Ekind (Id) = E_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
|
|
|
|
|
return Node26 (Id);
|
|
|
|
|
end Package_Instantiation;
|
|
|
|
|
|
|
|
|
@ -2398,8 +2358,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Prival_Link (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
return Node20 (Id);
|
|
|
|
|
end Prival_Link;
|
|
|
|
|
|
|
|
|
@ -2429,10 +2388,8 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Protection_Object (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Entry
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
|
|
|
|
|
return Node23 (Id);
|
|
|
|
|
end Protection_Object;
|
|
|
|
|
|
|
|
|
@ -2476,21 +2433,19 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Related_Expression (Id : E) return N is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
return Node24 (Id);
|
|
|
|
|
end Related_Expression;
|
|
|
|
|
|
|
|
|
|
function Related_Instance (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
|
|
|
|
|
return Node15 (Id);
|
|
|
|
|
end Related_Instance;
|
|
|
|
|
|
|
|
|
|
function Related_Type (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Constant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Constant));
|
|
|
|
|
return Node26 (Id);
|
|
|
|
|
end Related_Type;
|
|
|
|
|
|
|
|
|
@ -2576,8 +2531,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Shadow_Entities (Id : E) return S is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
|
|
|
|
|
return List14 (Id);
|
|
|
|
|
end Shadow_Entities;
|
|
|
|
|
|
|
|
|
@ -2589,7 +2543,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Size_Check_Code (Id : E) return N is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
return Node19 (Id);
|
|
|
|
|
end Size_Check_Code;
|
|
|
|
|
|
|
|
|
@ -2611,8 +2565,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Spec_Entity (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package_Body or else Is_Formal (Id));
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Package_Body or else Is_Formal (Id));
|
|
|
|
|
return Node19 (Id);
|
|
|
|
|
end Spec_Entity;
|
|
|
|
|
|
|
|
|
@ -2753,9 +2706,8 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Wrapped_Entity (Id : E) return E is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert ((Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure)
|
|
|
|
|
and then Is_Primitive_Wrapper (Id));
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
|
|
|
|
|
and then Is_Primitive_Wrapper (Id));
|
|
|
|
|
return Node27 (Id);
|
|
|
|
|
end Wrapped_Entity;
|
|
|
|
|
|
|
|
|
@ -2963,8 +2915,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Signed_Integer_Type (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
return Ekind (Id) in
|
|
|
|
|
Signed_Integer_Kind;
|
|
|
|
|
return Ekind (Id) in Signed_Integer_Kind;
|
|
|
|
|
end Is_Signed_Integer_Type;
|
|
|
|
|
|
|
|
|
|
function Is_Subprogram (Id : E) return B is
|
|
|
|
@ -3022,9 +2973,7 @@ package body Einfo is
|
|
|
|
|
procedure Set_Actual_Subtype (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable
|
|
|
|
|
or else Ekind (Id) = E_Generic_In_Out_Parameter
|
|
|
|
|
(Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)
|
|
|
|
|
or else Is_Formal (Id));
|
|
|
|
|
Set_Node17 (Id, V);
|
|
|
|
|
end Set_Actual_Subtype;
|
|
|
|
@ -3044,11 +2993,11 @@ package body Einfo is
|
|
|
|
|
procedure Set_Alignment (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Is_Type (Id)
|
|
|
|
|
or else Is_Formal (Id)
|
|
|
|
|
or else Ekind (Id) = E_Loop_Parameter
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Exception
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
or else Is_Formal (Id)
|
|
|
|
|
or else Ekind_In (Id, E_Loop_Parameter,
|
|
|
|
|
E_Constant,
|
|
|
|
|
E_Exception,
|
|
|
|
|
E_Variable));
|
|
|
|
|
Set_Uint14 (Id, V);
|
|
|
|
|
end Set_Alignment;
|
|
|
|
|
|
|
|
|
@ -3066,8 +3015,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Body_Entity (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
|
|
|
|
|
Set_Node19 (Id, V);
|
|
|
|
|
end Set_Body_Entity;
|
|
|
|
|
|
|
|
|
@ -3075,8 +3023,8 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package
|
|
|
|
|
or else Is_Subprogram (Id)
|
|
|
|
|
or else Is_Generic_Unit (Id));
|
|
|
|
|
or else Is_Subprogram (Id)
|
|
|
|
|
or else Is_Generic_Unit (Id));
|
|
|
|
|
Set_Flag40 (Id, V);
|
|
|
|
|
end Set_Body_Needed_For_SAL;
|
|
|
|
|
|
|
|
|
@ -3104,23 +3052,19 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Cloned_Subtype (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Record_Subtype
|
|
|
|
|
or else Ekind (Id) = E_Class_Wide_Subtype);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));
|
|
|
|
|
Set_Node16 (Id, V);
|
|
|
|
|
end Set_Cloned_Subtype;
|
|
|
|
|
|
|
|
|
|
procedure Set_Component_Bit_Offset (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
Set_Uint11 (Id, V);
|
|
|
|
|
end Set_Component_Bit_Offset;
|
|
|
|
|
|
|
|
|
|
procedure Set_Component_Clause (Id : E; V : N) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
Set_Node13 (Id, V);
|
|
|
|
|
end Set_Component_Clause;
|
|
|
|
|
|
|
|
|
@ -3225,9 +3169,7 @@ package body Einfo is
|
|
|
|
|
procedure Set_Delay_Subprogram_Descriptors (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Subprogram (Id)
|
|
|
|
|
or else Ekind (Id) = E_Package
|
|
|
|
|
or else Ekind (Id) = E_Package_Body);
|
|
|
|
|
(Is_Subprogram (Id) or else Ekind_In (Id, E_Package, E_Package_Body));
|
|
|
|
|
Set_Flag50 (Id, V);
|
|
|
|
|
end Set_Delay_Subprogram_Descriptors;
|
|
|
|
|
|
|
|
|
@ -3320,14 +3262,13 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_DT_Position (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Uint15 (Id, V);
|
|
|
|
|
end Set_DT_Position;
|
|
|
|
|
|
|
|
|
|
procedure Set_DTC_Entity (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Node16 (Id, V);
|
|
|
|
|
end Set_DTC_Entity;
|
|
|
|
|
|
|
|
|
@ -3428,12 +3369,12 @@ package body Einfo is
|
|
|
|
|
procedure Set_Equivalent_Type (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Class_Wide_Type or else
|
|
|
|
|
Ekind (Id) = E_Class_Wide_Subtype or else
|
|
|
|
|
Ekind (Id) = E_Access_Protected_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Anonymous_Access_Protected_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Access_Subprogram_Type or else
|
|
|
|
|
Ekind (Id) = E_Exception_Type);
|
|
|
|
|
(Ekind_In (Id, E_Class_Wide_Type,
|
|
|
|
|
E_Class_Wide_Subtype,
|
|
|
|
|
E_Access_Protected_Subprogram_Type,
|
|
|
|
|
E_Anonymous_Access_Protected_Subprogram_Type,
|
|
|
|
|
E_Access_Subprogram_Type,
|
|
|
|
|
E_Exception_Type));
|
|
|
|
|
Set_Node18 (Id, V);
|
|
|
|
|
end Set_Equivalent_Type;
|
|
|
|
|
|
|
|
|
@ -3469,9 +3410,9 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Body
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type);
|
|
|
|
|
or else Ekind_In (Id, E_Entry_Family,
|
|
|
|
|
E_Subprogram_Body,
|
|
|
|
|
E_Subprogram_Type));
|
|
|
|
|
Set_Node28 (Id, V);
|
|
|
|
|
end Set_Extra_Formals;
|
|
|
|
|
|
|
|
|
@ -3519,16 +3460,14 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_First_Optional_Parameter (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Node14 (Id, V);
|
|
|
|
|
end Set_First_Optional_Parameter;
|
|
|
|
|
|
|
|
|
|
procedure Set_First_Private_Entity (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Package
|
|
|
|
|
or else Ekind (Id) = E_Generic_Package
|
|
|
|
|
or else Ekind (Id) in Concurrent_Kind);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
|
|
|
|
|
or else Ekind (Id) in Concurrent_Kind);
|
|
|
|
|
Set_Node16 (Id, V);
|
|
|
|
|
end Set_First_Private_Entity;
|
|
|
|
|
|
|
|
|
@ -3546,7 +3485,7 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Package);
|
|
|
|
|
or else Ekind (Id) = E_Package);
|
|
|
|
|
Set_Flag159 (Id, V);
|
|
|
|
|
end Set_From_With_Type;
|
|
|
|
|
|
|
|
|
@ -3713,8 +3652,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Has_Initial_Value (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Variable or else Ekind (Id) = E_Out_Parameter);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Variable, E_Out_Parameter));
|
|
|
|
|
Set_Flag219 (Id, V);
|
|
|
|
|
end Set_Has_Initial_Value;
|
|
|
|
|
|
|
|
|
@ -3731,8 +3669,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Has_Missing_Return (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function or else Ekind (Id) = E_Generic_Function);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Generic_Function));
|
|
|
|
|
Set_Flag142 (Id, V);
|
|
|
|
|
end Set_Has_Missing_Return;
|
|
|
|
|
|
|
|
|
@ -3743,10 +3680,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Has_Up_Level_Access (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Variable
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Loop_Parameter);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Variable, E_Constant, E_Loop_Parameter));
|
|
|
|
|
Set_Flag215 (Id, V);
|
|
|
|
|
end Set_Has_Up_Level_Access;
|
|
|
|
|
|
|
|
|
@ -3989,9 +3923,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Implemented_By_Entry (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Flag232 (Id, V);
|
|
|
|
|
end Set_Implemented_By_Entry;
|
|
|
|
|
|
|
|
|
@ -4006,8 +3938,7 @@ package body Einfo is
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Internal (Id)
|
|
|
|
|
and then Is_Hidden (Id)
|
|
|
|
|
and then (Ekind (Id) = E_Procedure
|
|
|
|
|
or else Ekind (Id) = E_Function));
|
|
|
|
|
and then (Ekind_In (Id, E_Procedure, E_Function)));
|
|
|
|
|
Set_Node25 (Id, V);
|
|
|
|
|
end Set_Interface_Alias;
|
|
|
|
|
|
|
|
|
@ -4100,8 +4031,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Is_Called (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Procedure or else Ekind (Id) = E_Function);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
|
|
|
|
|
Set_Flag102 (Id, V);
|
|
|
|
|
end Set_Is_Called;
|
|
|
|
|
|
|
|
|
@ -4224,10 +4154,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Record_Subtype
|
|
|
|
|
or else
|
|
|
|
|
Ekind (Id) = E_Private_Subtype);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
|
|
|
|
|
Set_Flag118 (Id, V);
|
|
|
|
|
end Set_Is_For_Access_Subtype;
|
|
|
|
|
|
|
|
|
@ -4288,12 +4215,12 @@ package body Einfo is
|
|
|
|
|
procedure Set_Is_Interface (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Record_Type
|
|
|
|
|
or else Ekind (Id) = E_Record_Subtype
|
|
|
|
|
or else Ekind (Id) = E_Record_Type_With_Private
|
|
|
|
|
or else Ekind (Id) = E_Record_Subtype_With_Private
|
|
|
|
|
or else Ekind (Id) = E_Class_Wide_Type
|
|
|
|
|
or else Ekind (Id) = E_Class_Wide_Subtype);
|
|
|
|
|
(Ekind_In (Id, E_Record_Type,
|
|
|
|
|
E_Record_Subtype,
|
|
|
|
|
E_Record_Type_With_Private,
|
|
|
|
|
E_Record_Subtype_With_Private,
|
|
|
|
|
E_Class_Wide_Type,
|
|
|
|
|
E_Class_Wide_Subtype));
|
|
|
|
|
Set_Flag186 (Id, V);
|
|
|
|
|
end Set_Is_Interface;
|
|
|
|
|
|
|
|
|
@ -4428,15 +4355,13 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Generic_Function
|
|
|
|
|
or else Ekind (Id) = E_Generic_Procedure);
|
|
|
|
|
or else Ekind_In (Id, E_Generic_Function, E_Generic_Procedure));
|
|
|
|
|
Set_Flag218 (Id, V);
|
|
|
|
|
end Set_Is_Primitive;
|
|
|
|
|
|
|
|
|
|
procedure Set_Is_Primitive_Wrapper (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Flag195 (Id, V);
|
|
|
|
|
end Set_Is_Primitive_Wrapper;
|
|
|
|
|
|
|
|
|
@ -4453,8 +4378,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Is_Private_Primitive (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
|
|
|
|
|
Set_Flag245 (Id, V);
|
|
|
|
|
end Set_Is_Private_Primitive;
|
|
|
|
|
|
|
|
|
@ -4521,11 +4445,11 @@ package body Einfo is
|
|
|
|
|
procedure Set_Is_Statically_Allocated (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Exception
|
|
|
|
|
or else Ekind (Id) = E_Variable
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Void);
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind_In (Id, E_Exception,
|
|
|
|
|
E_Variable,
|
|
|
|
|
E_Constant,
|
|
|
|
|
E_Void));
|
|
|
|
|
Set_Flag28 (Id, V);
|
|
|
|
|
end Set_Is_Statically_Allocated;
|
|
|
|
|
|
|
|
|
@ -4537,9 +4461,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Is_Tag (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component
|
|
|
|
|
or else Ekind (Id) = E_Constant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Constant));
|
|
|
|
|
Set_Flag78 (Id, V);
|
|
|
|
|
end Set_Is_Tag;
|
|
|
|
|
|
|
|
|
@ -4728,8 +4650,7 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family);
|
|
|
|
|
or else Ekind_In (Id, E_Subprogram_Type, E_Entry_Family));
|
|
|
|
|
Set_Flag22 (Id, V);
|
|
|
|
|
end Set_Needs_No_Actuals;
|
|
|
|
|
|
|
|
|
@ -4752,9 +4673,7 @@ package body Einfo is
|
|
|
|
|
procedure Set_No_Return (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(V = False
|
|
|
|
|
or else Ekind (Id) = E_Procedure
|
|
|
|
|
or else Ekind (Id) = E_Generic_Procedure);
|
|
|
|
|
(V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
|
|
|
|
|
Set_Flag113 (Id, V);
|
|
|
|
|
end Set_No_Return;
|
|
|
|
|
|
|
|
|
@ -4786,22 +4705,19 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Normalized_First_Bit (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
Set_Uint8 (Id, V);
|
|
|
|
|
end Set_Normalized_First_Bit;
|
|
|
|
|
|
|
|
|
|
procedure Set_Normalized_Position (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
Set_Uint14 (Id, V);
|
|
|
|
|
end Set_Normalized_Position;
|
|
|
|
|
|
|
|
|
|
procedure Set_Normalized_Position_Max (Id : E; V : U) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));
|
|
|
|
|
Set_Uint10 (Id, V);
|
|
|
|
|
end Set_Normalized_Position_Max;
|
|
|
|
|
|
|
|
|
@ -4821,18 +4737,14 @@ package body Einfo is
|
|
|
|
|
procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
(Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
Set_Flag241 (Id, V);
|
|
|
|
|
end Set_Optimize_Alignment_Space;
|
|
|
|
|
|
|
|
|
|
procedure Set_Optimize_Alignment_Time (Id : E; V : B := True) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Type (Id)
|
|
|
|
|
or else Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
(Is_Type (Id) or else Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
Set_Flag242 (Id, V);
|
|
|
|
|
end Set_Optimize_Alignment_Time;
|
|
|
|
|
|
|
|
|
@ -4844,10 +4756,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Original_Record_Component (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Void
|
|
|
|
|
or else Ekind (Id) = E_Component
|
|
|
|
|
or else Ekind (Id) = E_Discriminant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Void, E_Component, E_Discriminant));
|
|
|
|
|
Set_Node22 (Id, V);
|
|
|
|
|
end Set_Original_Record_Component;
|
|
|
|
|
|
|
|
|
@ -4863,10 +4772,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Package_Instantiation (Id : E; V : N) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Void
|
|
|
|
|
or else Ekind (Id) = E_Generic_Package
|
|
|
|
|
or else Ekind (Id) = E_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Void, E_Generic_Package, E_Package));
|
|
|
|
|
Set_Node26 (Id, V);
|
|
|
|
|
end Set_Package_Instantiation;
|
|
|
|
|
|
|
|
|
@ -4902,8 +4808,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Prival_Link (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
Set_Node20 (Id, V);
|
|
|
|
|
end Set_Prival_Link;
|
|
|
|
|
|
|
|
|
@ -4933,10 +4838,10 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Protection_Object (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Entry
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Entry,
|
|
|
|
|
E_Entry_Family,
|
|
|
|
|
E_Function,
|
|
|
|
|
E_Procedure));
|
|
|
|
|
Set_Node23 (Id, V);
|
|
|
|
|
end Set_Protection_Object;
|
|
|
|
|
|
|
|
|
@ -4985,15 +4890,13 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Related_Instance (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Package_Body);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Package_Body));
|
|
|
|
|
Set_Node15 (Id, V);
|
|
|
|
|
end Set_Related_Instance;
|
|
|
|
|
|
|
|
|
|
procedure Set_Related_Type (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Component or else Ekind (Id) = E_Constant);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Component, E_Constant));
|
|
|
|
|
Set_Node26 (Id, V);
|
|
|
|
|
end Set_Related_Type;
|
|
|
|
|
|
|
|
|
@ -5081,8 +4984,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Shadow_Entities (Id : E; V : S) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Ekind (Id) = E_Package or else Ekind (Id) = E_Generic_Package);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
|
|
|
|
|
Set_List14 (Id, V);
|
|
|
|
|
end Set_Shadow_Entities;
|
|
|
|
|
|
|
|
|
@ -5094,7 +4996,7 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Size_Check_Code (Id : E; V : N) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Constant, E_Variable));
|
|
|
|
|
Set_Node19 (Id, V);
|
|
|
|
|
end Set_Size_Check_Code;
|
|
|
|
|
|
|
|
|
@ -5268,9 +5170,8 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
procedure Set_Wrapped_Entity (Id : E; V : E) is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert ((Ekind (Id) = E_Function
|
|
|
|
|
or else Ekind (Id) = E_Procedure)
|
|
|
|
|
and then Is_Primitive_Wrapper (Id));
|
|
|
|
|
pragma Assert (Ekind_In (Id, E_Function, E_Procedure)
|
|
|
|
|
and then Is_Primitive_Wrapper (Id));
|
|
|
|
|
Set_Node27 (Id, V);
|
|
|
|
|
end Set_Wrapped_Entity;
|
|
|
|
|
|
|
|
|
@ -5765,9 +5666,9 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Body
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type);
|
|
|
|
|
or else Ekind_In (Id, E_Entry_Family,
|
|
|
|
|
E_Subprogram_Body,
|
|
|
|
|
E_Subprogram_Type));
|
|
|
|
|
|
|
|
|
|
if Ekind (Id) = E_Enumeration_Literal then
|
|
|
|
|
return Empty;
|
|
|
|
@ -5793,9 +5694,9 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
pragma Assert
|
|
|
|
|
(Is_Overloadable (Id)
|
|
|
|
|
or else Ekind (Id) = E_Entry_Family
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Body
|
|
|
|
|
or else Ekind (Id) = E_Subprogram_Type);
|
|
|
|
|
or else Ekind_In (Id, E_Entry_Family,
|
|
|
|
|
E_Subprogram_Body,
|
|
|
|
|
E_Subprogram_Type));
|
|
|
|
|
|
|
|
|
|
if Ekind (Id) = E_Enumeration_Literal then
|
|
|
|
|
return Empty;
|
|
|
|
@ -6098,10 +5999,8 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Discriminal (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
return
|
|
|
|
|
(Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_In_Parameter)
|
|
|
|
|
and then Present (Discriminal_Link (Id));
|
|
|
|
|
return (Ekind_In (Id, E_Constant, E_In_Parameter)
|
|
|
|
|
and then Present (Discriminal_Link (Id)));
|
|
|
|
|
end Is_Discriminal;
|
|
|
|
|
|
|
|
|
|
----------------------
|
|
|
|
@ -6169,10 +6068,8 @@ package body Einfo is
|
|
|
|
|
|
|
|
|
|
function Is_Prival (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
return
|
|
|
|
|
(Ekind (Id) = E_Constant
|
|
|
|
|
or else Ekind (Id) = E_Variable)
|
|
|
|
|
and then Present (Prival_Link (Id));
|
|
|
|
|
return (Ekind_In (Id, E_Constant, E_Variable)
|
|
|
|
|
and then Present (Prival_Link (Id)));
|
|
|
|
|
end Is_Prival;
|
|
|
|
|
|
|
|
|
|
----------------------------
|
|
|
|
@ -6227,8 +6124,8 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
return Ekind (Id) in String_Kind
|
|
|
|
|
or else (Is_Array_Type (Id)
|
|
|
|
|
and then Number_Dimensions (Id) = 1
|
|
|
|
|
and then Is_Character_Type (Component_Type (Id)));
|
|
|
|
|
and then Number_Dimensions (Id) = 1
|
|
|
|
|
and then Is_Character_Type (Component_Type (Id)));
|
|
|
|
|
end Is_String_Type;
|
|
|
|
|
|
|
|
|
|
-------------------------
|
|
|
|
@ -6249,7 +6146,7 @@ package body Einfo is
|
|
|
|
|
function Is_Wrapper_Package (Id : E) return B is
|
|
|
|
|
begin
|
|
|
|
|
return (Ekind (Id) = E_Package
|
|
|
|
|
and then Present (Related_Instance (Id)));
|
|
|
|
|
and then Present (Related_Instance (Id)));
|
|
|
|
|
end Is_Wrapper_Package;
|
|
|
|
|
|
|
|
|
|
--------------------
|
|
|
|
@ -6279,9 +6176,7 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
Comp_Id := Next_Entity (Id);
|
|
|
|
|
while Present (Comp_Id) loop
|
|
|
|
|
exit when Ekind (Comp_Id) = E_Component
|
|
|
|
|
or else
|
|
|
|
|
Ekind (Comp_Id) = E_Discriminant;
|
|
|
|
|
exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
|
|
|
|
|
Comp_Id := Next_Entity (Comp_Id);
|
|
|
|
|
end loop;
|
|
|
|
|
|
|
|
|
@ -6318,7 +6213,7 @@ package body Einfo is
|
|
|
|
|
D := Next_Entity (D);
|
|
|
|
|
if No (D)
|
|
|
|
|
or else (Ekind (D) /= E_Discriminant
|
|
|
|
|
and then not Is_Itype (D))
|
|
|
|
|
and then not Is_Itype (D))
|
|
|
|
|
then
|
|
|
|
|
return Empty;
|
|
|
|
|
end if;
|
|
|
|
@ -8105,9 +8000,7 @@ package body Einfo is
|
|
|
|
|
begin
|
|
|
|
|
N := Next_Entity (N);
|
|
|
|
|
while Present (N) loop
|
|
|
|
|
exit when Ekind (N) = E_Component
|
|
|
|
|
or else
|
|
|
|
|
Ekind (N) = E_Discriminant;
|
|
|
|
|
exit when Ekind_In (N, E_Component, E_Discriminant);
|
|
|
|
|
N := Next_Entity (N);
|
|
|
|
|
end loop;
|
|
|
|
|
end Proc_Next_Component_Or_Discriminant;
|
|
|
|
|