-- Usage of Fields in Defining Entity Nodes --
----------------------------------------------
- -- Four of these fields are defined in Sinfo, since they in are the
- -- base part of the node. The access routines for these fields and the
+ -- Four of these fields are defined in Sinfo, since they in are the base
+ -- part of the node. The access routines for these four fields and the
-- corresponding set procedures are defined in Sinfo. These fields are
-- present in all entities. Note that Homonym is also in the base part of
-- the node, but has access routines that are more properly part of Einfo,
-- Protection_Object Node23
-- Stored_Constraint Elist23
+ -- Related_Expression Node24
-- Spec_PPC_List Node24
+ -- Underlying_Record_View Node24
-- Interface_Alias Node25
-- Interfaces Elist25
-- Overlays_Constant Flag243
-- Is_RACW_Stub_Type Flag244
-- Is_Private_Primitive Flag245
-
- -- (unused) Flag246
- -- (unused) Flag247
+ -- Is_Underlying_Record_View Flag246
+ -- OK_To_Rename Flag247
-----------------------
-- Local subprograms --
begin
pragma Assert
(Ekind (Id) = E_Record_Subtype
- or else Ekind (Id) = E_Class_Wide_Subtype);
+ or else
+ Ekind (Id) = E_Class_Wide_Subtype);
return Node16 (Id);
end Cloned_Subtype;
function Component_Type (Id : E) return E is
begin
+ pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
return Node20 (Implementation_Base_Type (Id));
end Component_Type;
function Directly_Designated_Type (Id : E) return E is
begin
+ pragma Assert (Is_Access_Type (Id));
return Node20 (Id);
end Directly_Designated_Type;
return Flag117 (Implementation_Base_Type (Id));
end Is_Unchecked_Union;
+ function Is_Underlying_Record_View (Id : E) return B is
+ begin
+ return Flag246 (Id);
+ end Is_Underlying_Record_View;
+
function Is_Unsigned_Type (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
return Uint10 (Id);
end Normalized_Position_Max;
+ function OK_To_Rename (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_Variable);
+ return Flag247 (Id);
+ end OK_To_Rename;
+
function OK_To_Reorder_Components (Id : E) return B is
begin
pragma Assert (Is_Record_Type (Id));
function Parent_Subtype (Id : E) return E is
begin
- pragma Assert (Ekind (Id) = E_Record_Type);
- return Node19 (Id);
+ pragma Assert (Is_Record_Type (Id));
+ return Node19 (Base_Type (Id));
end Parent_Subtype;
function Postcondition_Proc (Id : E) return E is
return Node19 (Id);
end Related_Array_Object;
+ function Related_Expression (Id : E) return N is
+ begin
+ pragma Assert (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable);
+ return Node24 (Id);
+ end Related_Expression;
+
function Related_Instance (Id : E) return E is
begin
pragma Assert
return Node19 (Id);
end Underlying_Full_View;
+ function Underlying_Record_View (Id : E) return E is
+ begin
+ return Node24 (Id);
+ end Underlying_Record_View;
+
function Universal_Aliasing (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
Set_Flag117 (Id, V);
end Set_Is_Unchecked_Union;
+ procedure Set_Is_Underlying_Record_View (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Record_Type);
+ Set_Flag246 (Id, V);
+ end Set_Is_Underlying_Record_View;
+
procedure Set_Is_Unsigned_Type (Id : E; V : B := True) is
begin
pragma Assert (Is_Discrete_Or_Fixed_Point_Type (Id));
Set_Uint10 (Id, V);
end Set_Normalized_Position_Max;
+ procedure Set_OK_To_Rename (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_Variable);
+ Set_Flag247 (Id, V);
+ end Set_OK_To_Rename;
+
procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is
begin
pragma Assert
Set_Node19 (Id, V);
end Set_Related_Array_Object;
+ procedure Set_Related_Expression (Id : E; V : N) is
+ begin
+ Set_Node24 (Id, V);
+ end Set_Related_Expression;
+
procedure Set_Related_Instance (Id : E; V : E) is
begin
pragma Assert
Set_Node19 (Id, V);
end Set_Underlying_Full_View;
+ procedure Set_Underlying_Record_View (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind (Id) = E_Record_Type);
+ Set_Node24 (Id, V);
+ end Set_Underlying_Record_View;
+
procedure Set_Universal_Aliasing (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id) and then Id = Base_Type (Id));
W ("Is_Trivial_Subprogram", Flag235 (Id));
W ("Is_True_Constant", Flag163 (Id));
W ("Is_Unchecked_Union", Flag117 (Id));
+ W ("Is_Underlying_Record_View", Flag246 (Id));
W ("Is_Unsigned_Type", Flag144 (Id));
W ("Is_VMS_Exception", Flag133 (Id));
W ("Is_Valued_Procedure", Flag127 (Id));
W ("No_Strict_Aliasing", Flag136 (Id));
W ("Non_Binary_Modulus", Flag58 (Id));
W ("Nonzero_Is_True", Flag162 (Id));
+ W ("OK_To_Rename", Flag247 (Id));
W ("OK_To_Reorder_Components", Flag239 (Id));
W ("Optimize_Alignment_Space", Flag241 (Id));
W ("Optimize_Alignment_Time", Flag242 (Id));
when Subprogram_Kind =>
Write_Str ("Spec_PPC_List");
+ when E_Record_Type =>
+ Write_Str ("Underlying record view");
+
+ when E_Variable | E_Constant =>
+ Write_Str ("Related expression");
+
when others =>
Write_Str ("???");
end case;
OSDN Git Service
