-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Homonym Node4
-- First_Rep_Item Node6
-- Freeze_Node Node7
+ -- Prev_Entity Node36
-- Associated_Entity Node37
-- The usage of other fields (and the entity kinds to which it applies)
-- Alignment Uint14
-- Normalized_Position Uint14
-- Postconditions_Proc Node14
- -- Shadow_Entities List14
-- Discriminant_Number Uint15
-- DT_Position Uint15
-- Extra_Accessibility_Of_Result Node19
-- Non_Limited_View Node19
-- Parent_Subtype Node19
+ -- Receiving_Entry Node19
-- Size_Check_Code Node19
-- Spec_Entity Node19
-- Underlying_Full_View Node19
-- Corresponding_Remote_Type Node22
-- Enumeration_Rep_Expr Node22
-- Original_Record_Component Node22
- -- Private_View Node22
-- Protected_Formal Node22
-- Scope_Depth_Value Uint22
-- Shared_Var_Procs_Instance Node22
-- Stored_Constraint Elist23
-- Incomplete_Actuals Elist24
+ -- Minimum_Accessibility Node24
-- Related_Expression Node24
-- Subps_Index Uint24
-- Access_Disp_Table_Elab_Flag Node30
-- Anonymous_Object Node30
-- Corresponding_Equality Node30
+ -- Hidden_In_Formal_Instance Elist30
-- Last_Aggregate_Assignment Node30
-- Static_Initialization Node30
+ -- Activation_Record_Component Node31
-- Derived_Type_Link Node31
-- Thunk_Entity Node31
- -- Activation_Record_Component Node31
-- Corresponding_Function Node32
-- Corresponding_Procedure Node32
-- Entry_Max_Queue_Lengths_Array Node35
-- Import_Pragma Node35
- -- Validated_Object Node36
-
+ -- Validated_Object Node38
+ -- Predicated_Parent Node38
-- Class_Wide_Clone Node38
+
+ -- Protected_Subprogram Node39
+
-- SPARK_Pragma Node40
-- Original_Protected_Subprogram Node41
-- Body_Needed_For_SAL Flag40
-- Treat_As_Volatile Flag41
- -- Is_Controlled Flag42
+ -- Is_Controlled_Active Flag42
-- Has_Controlled_Component Flag43
-- Is_Pure Flag44
-- In_Private_Part Flag45
-- Never_Set_In_Source Flag115
-- Is_Visible_Lib_Unit Flag116
-- Is_Unchecked_Union Flag117
- -- Is_For_Access_Subtype Flag118
-- Has_Convention_Pragma Flag119
-- Has_Primitive_Operations Flag120
-- Strict_Alignment Flag145
-- Is_Abstract_Type Flag146
-- Needs_Debug_Info Flag147
- -- Suppress_Elaboration_Warnings Flag148
+ -- Is_Elaboration_Checks_OK_Id Flag148
-- Is_Compilation_Unit Flag149
-- Has_Pragma_Elaborate_Body Flag150
-- Has_Private_Extension Flag300
-- Ignore_SPARK_Mode_Pragmas Flag301
- -- (unused) Flag302
- -- (unused) Flag303
- -- (unused) Flag304
- -- (unused) Flag305
- -- (unused) Flag306
- -- (unused) Flag307
- -- (unused) Flag308
+ -- Is_Initial_Condition_Procedure Flag302
+ -- Suppress_Elaboration_Warnings Flag303
+ -- Is_Elaboration_Warnings_OK_Id Flag304
+ -- Is_Activation_Record Flag305
+ -- Needs_Activation_Record Flag306
+ -- Is_Loop_Parameter Flag307
+ -- Invariants_Ignored Flag308
+
-- (unused) Flag309
-- Note: Flag310-317 are defined in atree.ads/adb, but not yet in atree.h
function Abstract_States (Id : E) return L is
begin
- pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
return Elist25 (Id);
end Abstract_States;
function Body_Entity (Id : E) return E is
begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
return Node19 (Id);
end Body_Entity;
pragma Assert
(Is_Subprogram (Id)
or else
- Ekind (Id) = E_Package
+ Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
or else
Is_Generic_Unit (Id));
return Node13 (Id);
pragma Assert
(Is_Subprogram (Id)
or else
- Ekind (Id) = E_Package
+ Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
or else
Is_Generic_Unit (Id));
return Flag174 (Id);
function Contract (Id : E) return N is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Body,
E_Task_Type)
or else
- Ekind_In (Id, E_Constant, -- object variants
+ Ekind_In (Id, E_Constant, -- objects
E_Variable)
or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ Ekind_In (Id, E_Entry, -- overloadable
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Void); -- special purpose
+ Ekind (Id) = E_Void); -- special purpose
return Node34 (Id);
end Contract;
function First_Private_Entity (Id : E) return E is
begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
- or else Ekind (Id) in Concurrent_Kind);
+ pragma Assert (Is_Package_Or_Generic_Package (Id)
+ or else Is_Concurrent_Type (Id));
return Node16 (Id);
end First_Private_Entity;
function Has_Discriminants (Id : E) return B is
begin
- pragma Assert (Nkind (Id) in N_Entity);
+ pragma Assert (Is_Type (Id));
return Flag5 (Id);
end Has_Discriminants;
return Node8 (Id);
end Hiding_Loop_Variable;
+ function Hidden_In_Formal_Instance (Id : E) return L is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ return Elist30 (Id);
+ end Hidden_In_Formal_Instance;
+
function Homonym (Id : E) return E is
begin
return Node4 (Id);
function Ignore_SPARK_Mode_Pragmas (Id : E) return B is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Body, -- concurrent types
E_Protected_Type,
E_Task_Body,
E_Task_Type)
or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ Ekind_In (Id, E_Entry, -- overloadable
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
return Flag301 (Id);
return Node21 (Id);
end Interface_Name;
+ function Invariants_Ignored (Id : E) return B is
+ begin
+ pragma Assert (Is_Type (Id));
+ return Flag308 (Id);
+ end Invariants_Ignored;
+
function Is_Abstract_Subprogram (Id : E) return B is
begin
pragma Assert (Is_Overloadable (Id));
return Flag69 (Id);
end Is_Access_Constant;
+ function Is_Activation_Record (Id : E) return B is
+ begin
+ pragma Assert (Ekind (Id) = E_In_Parameter);
+ return Flag305 (Id);
+ end Is_Activation_Record;
+
function Is_Actual_Subtype (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
function Is_Called (Id : E) return B is
begin
- pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
+ pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package));
return Flag102 (Id);
end Is_Called;
return Flag76 (Id);
end Is_Constructor;
- function Is_Controlled (Id : E) return B is
+ function Is_Controlled_Active (Id : E) return B is
begin
return Flag42 (Base_Type (Id));
- end Is_Controlled;
+ end Is_Controlled_Active;
function Is_Controlling_Formal (Id : E) return B is
begin
return Flag6 (Id);
end Is_Dispatching_Operation;
+ function Is_Elaboration_Checks_OK_Id (Id : E) return B is
+ begin
+ pragma Assert (Is_Elaboration_Target (Id));
+ return Flag148 (Id);
+ end Is_Elaboration_Checks_OK_Id;
+
+ function Is_Elaboration_Warnings_OK_Id (Id : E) return B is
+ begin
+ pragma Assert (Is_Elaboration_Target (Id) or else Ekind (Id) = E_Void);
+ return Flag304 (Id);
+ end Is_Elaboration_Warnings_OK_Id;
+
function Is_Eliminated (Id : E) return B is
begin
return Flag124 (Id);
return Flag70 (Id);
end Is_First_Subtype;
- function Is_For_Access_Subtype (Id : E) return B is
- begin
- pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
- return Flag118 (Id);
- end Is_For_Access_Subtype;
-
function Is_Formal_Subprogram (Id : E) return B is
begin
return Flag111 (Id);
function Is_Generic_Actual_Subprogram (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 Flag274 (Id);
end Is_Generic_Actual_Subprogram;
return Flag268 (Id);
end Is_Independent;
+ function Is_Initial_Condition_Procedure (Id : E) return B is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
+ return Flag302 (Id);
+ end Is_Initial_Condition_Procedure;
+
function Is_Inlined (Id : E) return B is
begin
return Flag11 (Id);
function Is_Inlined_Always (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 Flag1 (Id);
end Is_Inlined_Always;
return Flag194 (Id);
end Is_Local_Anonymous_Access;
+ function Is_Loop_Parameter (Id : E) return B is
+ begin
+ return Flag307 (Id);
+ end Is_Loop_Parameter;
+
function Is_Machine_Code_Subprogram (Id : E) return B is
begin
pragma Assert (Is_Subprogram (Id));
return UI_To_Int (Uint8 (Id));
end Mechanism;
+ function Minimum_Accessibility (Id : E) return E is
+ begin
+ pragma Assert (Ekind (Id) in Formal_Kind);
+ return Node24 (Id);
+ end Minimum_Accessibility;
+
function Modulus (Id : E) return Uint is
begin
pragma Assert (Is_Modular_Integer_Type (Id));
return Flag208 (Id);
end Must_Have_Preelab_Init;
+ function Needs_Activation_Record (Id : E) return B is
+ begin
+ return Flag306 (Id);
+ end Needs_Activation_Record;
+
function Needs_Debug_Info (Id : E) return B is
begin
return Flag147 (Id);
function Package_Instantiation (Id : E) return N is
begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
return Node26 (Id);
end Package_Instantiation;
return Node14 (Id);
end Postconditions_Proc;
+ function Predicated_Parent (Id : E) return E is
+ begin
+ pragma Assert (Ekind_In (Id, E_Array_Subtype,
+ E_Record_Subtype,
+ E_Record_Subtype_With_Private));
+ return Node38 (Id);
+ end Predicated_Parent;
+
function Predicates_Ignored (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
return Flag288 (Id);
end Predicates_Ignored;
+ function Prev_Entity (Id : E) return E is
+ begin
+ return Node36 (Id);
+ end Prev_Entity;
+
function Prival (Id : E) return E is
begin
pragma Assert (Is_Protected_Component (Id));
return Elist18 (Id);
end Private_Dependents;
- function Private_View (Id : E) return N is
- begin
- pragma Assert (Is_Private_Type (Id));
- return Node22 (Id);
- end Private_View;
-
function Protected_Body_Subprogram (Id : E) return E is
begin
pragma Assert (Is_Subprogram (Id) or else Is_Entry (Id));
return Node22 (Id);
end Protected_Formal;
+ function Protected_Subprogram (Id : E) return N is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
+ return Node39 (Id);
+ end Protected_Subprogram;
+
function Protection_Object (Id : E) return E is
begin
- pragma Assert
- (Ekind_In (Id, E_Entry, E_Entry_Family, E_Function, E_Procedure));
+ pragma Assert (Ekind_In (Id, E_Entry,
+ E_Entry_Family,
+ E_Function,
+ E_Procedure));
return Node23 (Id);
end Protection_Object;
return Flag49 (Id);
end Reachable;
+ function Receiving_Entry (Id : E) return E is
+ begin
+ pragma Assert (Ekind (Id) = E_Procedure);
+ return Node19 (Id);
+ end Receiving_Entry;
+
function Referenced (Id : E) return B is
begin
return Flag156 (Id);
return Flag167 (Id);
end Sec_Stack_Needed_For_Return;
- function Shadow_Entities (Id : E) return S is
- begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
- return List14 (Id);
- end Shadow_Entities;
-
function Shared_Var_Procs_Instance (Id : E) return E is
begin
pragma Assert (Ekind (Id) = E_Variable);
function SPARK_Aux_Pragma (Id : E) return N is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Type)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
return Node41 (Id);
function SPARK_Aux_Pragma_Inherited (Id : E) return B is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Type)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
return Flag266 (Id);
function SPARK_Pragma (Id : E) return N is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
- E_Protected_Type,
- E_Task_Body,
- E_Task_Type)
+ (Ekind_In (Id, E_Constant, -- objects
+ E_Variable)
or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ Ekind_In (Id, E_Abstract_State, -- overloadable
+ E_Entry,
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Variable); -- variable
+ Ekind (Id) = E_Void -- special purpose
+ or else
+ Ekind_In (Id, E_Protected_Body, -- types
+ E_Task_Body)
+ or else
+ Is_Type (Id));
return Node40 (Id);
end SPARK_Pragma;
function SPARK_Pragma_Inherited (Id : E) return B is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
- E_Protected_Type,
- E_Task_Body,
- E_Task_Type)
- or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ (Ekind_In (Id, E_Constant, -- objects
+ E_Variable)
+ or else
+ Ekind_In (Id, E_Abstract_State, -- overloadable
+ E_Entry,
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Variable); -- variable
+ Ekind (Id) = E_Void -- special purpose
+ or else
+ Ekind_In (Id, E_Protected_Body, -- types
+ E_Task_Body)
+ or else
+ Is_Type (Id));
return Flag265 (Id);
end SPARK_Pragma_Inherited;
function Suppress_Elaboration_Warnings (Id : E) return B is
begin
- return Flag148 (Id);
+ return Flag303 (Id);
end Suppress_Elaboration_Warnings;
function Suppress_Initialization (Id : E) return B is
function Validated_Object (Id : E) return N is
begin
pragma Assert (Ekind (Id) = E_Variable);
- return Node36 (Id);
+ return Node38 (Id);
end Validated_Object;
function Warnings_Off (Id : E) return B is
procedure Set_Abstract_States (Id : E; V : L) is
begin
- pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
Set_Elist25 (Id, V);
end Set_Abstract_States;
procedure Set_Body_Entity (Id : E; V : E) is
begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
Set_Node19 (Id, V);
end Set_Body_Entity;
procedure Set_Contract (Id : E; V : N) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Body,
E_Task_Type)
or else
- Ekind_In (Id, E_Constant, -- object variants
+ Ekind_In (Id, E_Constant, -- objects
E_Variable)
or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ Ekind_In (Id, E_Entry, -- overloadable
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Void); -- special purpose
+ Ekind (Id) = E_Void); -- special purpose
Set_Node34 (Id, V);
end Set_Contract;
pragma Assert
(Is_Subprogram (Id)
or else
- Ekind (Id) = E_Package
+ Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
or else
Is_Generic_Unit (Id));
Set_Node13 (Id, V);
pragma Assert
(Is_Subprogram (Id)
or else
- Ekind (Id) = E_Package
+ Ekind_In (Id, E_Entry, E_Entry_Family, E_Package)
or else
Is_Generic_Unit (Id));
Set_Flag174 (Id, V);
procedure Set_First_Private_Entity (Id : E; V : E) is
begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package)
- or else Ekind (Id) in Concurrent_Kind);
+ pragma Assert (Is_Package_Or_Generic_Package (Id)
+ or else Is_Concurrent_Type (Id));
Set_Node16 (Id, V);
end Set_First_Private_Entity;
procedure Set_Has_Discriminants (Id : E; V : B := True) is
begin
- pragma Assert (Nkind (Id) in N_Entity);
+ pragma Assert (Is_Type (Id));
Set_Flag5 (Id, V);
end Set_Has_Discriminants;
Set_Node8 (Id, V);
end Set_Hiding_Loop_Variable;
+ procedure Set_Hidden_In_Formal_Instance (Id : E; V : L) is
+ begin
+ pragma Assert (Ekind (Id) = E_Package);
+ Set_Elist30 (Id, V);
+ end Set_Hidden_In_Formal_Instance;
+
procedure Set_Homonym (Id : E; V : E) is
begin
pragma Assert (Id /= V);
procedure Set_Ignore_SPARK_Mode_Pragmas (Id : E; V : B := True) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Body, -- concurrent types
E_Protected_Type,
E_Task_Body,
E_Task_Type)
or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ Ekind_In (Id, E_Entry, -- overloadable
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
Set_Flag301 (Id, V);
Set_Node21 (Id, V);
end Set_Interface_Name;
+ procedure Set_Invariants_Ignored (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Type (Id));
+ Set_Flag308 (Id, V);
+ end Set_Invariants_Ignored;
+
procedure Set_Is_Abstract_Subprogram (Id : E; V : B := True) is
begin
pragma Assert (Is_Overloadable (Id));
Set_Flag69 (Id, V);
end Set_Is_Access_Constant;
+ procedure Set_Is_Activation_Record (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind (Id) = E_In_Parameter);
+ Set_Flag305 (Id, V);
+ end Set_Is_Activation_Record;
+
procedure Set_Is_Actual_Subtype (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
procedure Set_Is_Called (Id : E; V : B := True) is
begin
- pragma Assert (Ekind_In (Id, E_Procedure, E_Function));
+ pragma Assert (Ekind_In (Id, E_Procedure, E_Function, E_Package));
Set_Flag102 (Id, V);
end Set_Is_Called;
Set_Flag76 (Id, V);
end Set_Is_Constructor;
- procedure Set_Is_Controlled (Id : E; V : B := True) is
+ procedure Set_Is_Controlled_Active (Id : E; V : B := True) is
begin
pragma Assert (Id = Base_Type (Id));
Set_Flag42 (Id, V);
- end Set_Is_Controlled;
+ end Set_Is_Controlled_Active;
procedure Set_Is_Controlling_Formal (Id : E; V : B := True) is
begin
Set_Flag6 (Id, V);
end Set_Is_Dispatching_Operation;
+ procedure Set_Is_Elaboration_Checks_OK_Id (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Elaboration_Target (Id));
+ Set_Flag148 (Id, V);
+ end Set_Is_Elaboration_Checks_OK_Id;
+
+ procedure Set_Is_Elaboration_Warnings_OK_Id (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Elaboration_Target (Id));
+ Set_Flag304 (Id, V);
+ end Set_Is_Elaboration_Warnings_OK_Id;
+
procedure Set_Is_Eliminated (Id : E; V : B := True) is
begin
Set_Flag124 (Id, V);
Set_Flag70 (Id, V);
end Set_Is_First_Subtype;
- procedure Set_Is_For_Access_Subtype (Id : E; V : B := True) is
- begin
- pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Private_Subtype));
- Set_Flag118 (Id, V);
- end Set_Is_For_Access_Subtype;
-
procedure Set_Is_Formal_Subprogram (Id : E; V : B := True) is
begin
Set_Flag111 (Id, V);
Set_Flag268 (Id, V);
end Set_Is_Independent;
+ procedure Set_Is_Initial_Condition_Procedure (Id : E; V : B := True) is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
+ Set_Flag302 (Id, V);
+ end Set_Is_Initial_Condition_Procedure;
+
procedure Set_Is_Inlined (Id : E; V : B := True) is
begin
Set_Flag11 (Id, V);
procedure Set_Is_Inlined_Always (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_Flag1 (Id, V);
end Set_Is_Inlined_Always;
Set_Flag25 (Id, V);
end Set_Is_Limited_Record;
+ procedure Set_Is_Loop_Parameter (Id : E; V : B := True) is
+ begin
+ Set_Flag307 (Id, V);
+ end Set_Is_Loop_Parameter;
+
procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
begin
pragma Assert (Is_Subprogram (Id));
procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
begin
pragma Assert
- (Ekind_In (Id, E_Constant, E_Variable)
+ (Ekind_In (Id, E_Constant, E_Loop_Parameter, E_Variable)
or else Is_Formal (Id)
or else Is_Type (Id));
Set_Flag283 (Id, V);
Set_Uint8 (Id, UI_From_Int (V));
end Set_Mechanism;
+ procedure Set_Minimum_Accessibility (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind (Id) in Formal_Kind);
+ Set_Node24 (Id, V);
+ end Set_Minimum_Accessibility;
+
procedure Set_Modulus (Id : E; V : U) is
begin
pragma Assert (Ekind (Id) = E_Modular_Integer_Type);
Set_Flag208 (Id, V);
end Set_Must_Have_Preelab_Init;
+ procedure Set_Needs_Activation_Record (Id : E; V : B := True) is
+ begin
+ Set_Flag306 (Id, V);
+ end Set_Needs_Activation_Record;
+
procedure Set_Needs_Debug_Info (Id : E; V : B := True) is
begin
Set_Flag147 (Id, V);
Set_Node14 (Id, V);
end Set_Postconditions_Proc;
+ procedure Set_Predicated_Parent (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind_In (Id, E_Array_Subtype,
+ E_Record_Subtype,
+ E_Record_Subtype_With_Private));
+ Set_Node38 (Id, V);
+ end Set_Predicated_Parent;
+
procedure Set_Predicates_Ignored (Id : E; V : B) is
begin
pragma Assert (Is_Type (Id));
Set_Elist18 (Id, V);
end Set_Private_Dependents;
- procedure Set_Private_View (Id : E; V : N) is
+ procedure Set_Prev_Entity (Id : E; V : E) is
begin
- pragma Assert (Is_Private_Type (Id));
- Set_Node22 (Id, V);
- end Set_Private_View;
+ Set_Node36 (Id, V);
+ end Set_Prev_Entity;
procedure Set_Protected_Body_Subprogram (Id : E; V : E) is
begin
Set_Node22 (Id, V);
end Set_Protected_Formal;
+ procedure Set_Protected_Subprogram (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind_In (Id, E_Function, E_Procedure));
+ Set_Node39 (Id, V);
+ end Set_Protected_Subprogram;
+
procedure Set_Protection_Object (Id : E; V : E) is
begin
pragma Assert (Ekind_In (Id, E_Entry,
Set_Flag49 (Id, V);
end Set_Reachable;
+ procedure Set_Receiving_Entry (Id : E; V : E) is
+ begin
+ pragma Assert (Ekind (Id) = E_Procedure);
+ Set_Node19 (Id, V);
+ end Set_Receiving_Entry;
+
procedure Set_Referenced (Id : E; V : B := True) is
begin
Set_Flag156 (Id, V);
Set_Flag167 (Id, V);
end Set_Sec_Stack_Needed_For_Return;
- procedure Set_Shadow_Entities (Id : E; V : S) is
- begin
- pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));
- Set_List14 (Id, V);
- end Set_Shadow_Entities;
-
procedure Set_Shared_Var_Procs_Instance (Id : E; V : E) is
begin
pragma Assert (Ekind (Id) = E_Variable);
procedure Set_SPARK_Aux_Pragma (Id : E; V : N) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Type)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
Set_Node41 (Id, V);
procedure Set_SPARK_Aux_Pragma_Inherited (Id : E; V : B := True) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Type, -- concurrent variants
+ (Ekind_In (Id, E_Protected_Type, -- concurrent types
E_Task_Type)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body));
Set_Flag266 (Id, V);
procedure Set_SPARK_Pragma (Id : E; V : N) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
- E_Protected_Type,
- E_Task_Body,
- E_Task_Type)
- or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ (Ekind_In (Id, E_Constant, -- objects
+ E_Variable)
+ or else
+ Ekind_In (Id, E_Abstract_State, -- overloadable
+ E_Entry,
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Variable); -- variable
+ Ekind (Id) = E_Void -- special purpose
+ or else
+ Ekind_In (Id, E_Protected_Body, -- types
+ E_Task_Body)
+ or else
+ Is_Type (Id));
Set_Node40 (Id, V);
end Set_SPARK_Pragma;
procedure Set_SPARK_Pragma_Inherited (Id : E; V : B := True) is
begin
pragma Assert
- (Ekind_In (Id, E_Protected_Body, -- concurrent variants
- E_Protected_Type,
- E_Task_Body,
- E_Task_Type)
- or else
- Ekind_In (Id, E_Entry, -- overloadable variants
+ (Ekind_In (Id, E_Constant, -- objects
+ E_Variable)
+ or else
+ Ekind_In (Id, E_Abstract_State, -- overloadable
+ E_Entry,
E_Entry_Family,
E_Function,
E_Generic_Function,
E_Procedure,
E_Subprogram_Body)
or else
- Ekind_In (Id, E_Generic_Package, -- package variants
+ Ekind_In (Id, E_Generic_Package, -- packages
E_Package,
E_Package_Body)
or else
- Ekind (Id) = E_Variable); -- variable
+ Ekind (Id) = E_Void -- special purpose
+ or else
+ Ekind_In (Id, E_Protected_Body, -- types
+ E_Task_Body)
+ or else
+ Is_Type (Id));
Set_Flag265 (Id, V);
end Set_SPARK_Pragma_Inherited;
procedure Set_Suppress_Elaboration_Warnings (Id : E; V : B := True) is
begin
- Set_Flag148 (Id, V);
+ Set_Flag303 (Id, V);
end Set_Suppress_Elaboration_Warnings;
procedure Set_Suppress_Initialization (Id : E; V : B := True) is
procedure Set_Validated_Object (Id : E; V : N) is
begin
pragma Assert (Ekind (Id) = E_Variable);
- Set_Node36 (Id, V);
+ Set_Node38 (Id, V);
end Set_Validated_Object;
procedure Set_Warnings_Off (Id : E; V : B := True) is
-- Append_Entity --
-------------------
- procedure Append_Entity (Id : Entity_Id; V : Entity_Id) is
+ procedure Append_Entity (Id : Entity_Id; Scop : Entity_Id) is
+ Last : constant Entity_Id := Last_Entity (Scop);
+
begin
- if Last_Entity (V) = Empty then
- Set_First_Entity (Id => V, V => Id);
+ Set_Scope (Id, Scop);
+ Set_Prev_Entity (Id, Empty); -- Empty <-- Id
+
+ -- The entity chain is empty
+
+ if No (Last) then
+ Set_First_Entity (Scop, Id);
+
+ -- Otherwise the entity chain has at least one element
+
else
- Set_Next_Entity (Last_Entity (V), Id);
+ Link_Entities (Last, Id); -- Last <-- Id, Last --> Id
end if;
- Set_Next_Entity (Id, Empty);
- Set_Scope (Id, V);
- Set_Last_Entity (Id => V, V => Id);
+ -- NOTE: The setting of the Next_Entity attribute of Id must happen
+ -- here as opposed to at the beginning of the routine because doing
+ -- so causes the binder to hang. It is not clear why ???
+
+ Set_Next_Entity (Id, Empty); -- Id --> Empty
+
+ Set_Last_Entity (Scop, Id);
end Append_Entity;
---------------
Comp_Id := First_Entity (Id);
while Present (Comp_Id) loop
exit when Ekind (Comp_Id) = E_Component;
- Comp_Id := Next_Entity (Comp_Id);
+ Next_Entity (Comp_Id);
end loop;
return Comp_Id;
Comp_Id := First_Entity (Id);
while Present (Comp_Id) loop
exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
- Comp_Id := Next_Entity (Comp_Id);
+ Next_Entity (Comp_Id);
end loop;
return Comp_Id;
Id = Pragma_Initial_Condition or else
Id = Pragma_Initializes or else
Id = Pragma_Interrupt_Handler or else
+ Id = Pragma_No_Caching or else
Id = Pragma_Part_Of or else
Id = Pragma_Refined_Depends or else
Id = Pragma_Refined_Global or else
return True;
end if;
- Ent := Next_Entity (Ent);
+ Next_Entity (Ent);
end loop;
return False;
function Has_Non_Null_Abstract_State (Id : E) return B is
begin
- pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
return
Present (Abstract_States (Id))
-----------------------------
function Has_Null_Abstract_State (Id : E) return B is
+ pragma Assert (Is_Package_Or_Generic_Package (Id));
+
+ States : constant Elist_Id := Abstract_States (Id);
+
begin
- pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
+ -- Check first available state of related package. A null abstract
+ -- state always appears as the sole element of the state list.
return
- Present (Abstract_States (Id))
- and then Is_Null_State (Node (First_Elmt (Abstract_States (Id))));
+ Present (States)
+ and then Is_Null_State (Node (First_Elmt (States)));
end Has_Null_Abstract_State;
---------------------------------
------------------------
function Is_Constant_Object (Id : E) return B is
- K : constant Entity_Kind := Ekind (Id);
begin
- return
- K = E_Constant or else K = E_In_Parameter or else K = E_Loop_Parameter;
+ return Ekind_In (Id, E_Constant, E_In_Parameter, E_Loop_Parameter);
end Is_Constant_Object;
- --------------------------
- -- Is_Controlled_Active --
- --------------------------
+ -------------------
+ -- Is_Controlled --
+ -------------------
- function Is_Controlled_Active (Id : E) return B is
+ function Is_Controlled (Id : E) return B is
begin
- return Is_Controlled (Id) and then not Disable_Controlled (Id);
- end Is_Controlled_Active;
+ return Is_Controlled_Active (Id) and then not Disable_Controlled (Id);
+ end Is_Controlled;
--------------------
-- Is_Discriminal --
function Is_Discriminal (Id : E) return B is
begin
- return (Ekind_In (Id, E_Constant, 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;
----------------------
and then Is_Entity_Attribute_Name (Attribute_Name (N)));
end Is_Entity_Name;
+ ---------------------------
+ -- Is_Elaboration_Target --
+ ---------------------------
+
+ function Is_Elaboration_Target (Id : Entity_Id) return Boolean is
+ begin
+ return
+ Ekind_In (Id, E_Constant, E_Package, E_Variable)
+ or else Is_Entry (Id)
+ or else Is_Generic_Unit (Id)
+ or else Is_Subprogram (Id)
+ or else Is_Task_Type (Id);
+ end Is_Elaboration_Target;
+
-----------------------
-- Is_External_State --
-----------------------
function Is_External_State (Id : E) return B is
begin
+ -- To qualify, the abstract state must appear with option "external" or
+ -- "synchronous" (SPARK RM 7.1.4(7) and (9)).
+
return
- Ekind (Id) = E_Abstract_State and then Has_Option (Id, Name_External);
+ Ekind (Id) = E_Abstract_State
+ and then (Has_Option (Id, Name_External)
+ or else
+ Has_Option (Id, Name_Synchronous));
end Is_External_State;
------------------
function Is_Prival (Id : E) return B is
begin
- return (Ekind_In (Id, E_Constant, 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;
----------------------------
function Is_Synchronized_State (Id : E) return B is
begin
+ -- To qualify, the abstract state must appear with simple option
+ -- "synchronous" (SPARK RM 7.1.4(9)).
+
return
Ekind (Id) = E_Abstract_State
and then Has_Option (Id, Name_Synchronous);
function Is_Wrapper_Package (Id : E) return B is
begin
- return (Ekind (Id) = E_Package and then Present (Related_Instance (Id)));
+ return Ekind (Id) = E_Package and then Present (Related_Instance (Id));
end Is_Wrapper_Package;
-----------------
end if;
end Last_Formal;
+ -------------------
+ -- Link_Entities --
+ -------------------
+
+ procedure Link_Entities (First : Entity_Id; Second : Node_Id) is
+ begin
+ if Present (Second) then
+ Set_Prev_Entity (Second, First); -- First <-- Second
+ end if;
+
+ Set_Next_Entity (First, Second); -- First --> Second
+ end Link_Entities;
+
+ ----------------------
+ -- Model_Emin_Value --
+ ----------------------
+
function Model_Emin_Value (Id : E) return Uint is
begin
return Machine_Emin_Value (Id);
Comp_Id := Next_Entity (Id);
while Present (Comp_Id) loop
exit when Ekind (Comp_Id) = E_Component;
- Comp_Id := Next_Entity (Comp_Id);
+ Next_Entity (Comp_Id);
end loop;
return Comp_Id;
Comp_Id := Next_Entity (Id);
while Present (Comp_Id) loop
exit when Ekind_In (Comp_Id, E_Component, E_Discriminant);
- Comp_Id := Next_Entity (Comp_Id);
+ Next_Entity (Comp_Id);
end loop;
return Comp_Id;
pragma Assert (Ekind (Id) = E_Discriminant);
loop
- D := Next_Entity (D);
+ Next_Entity (D);
if No (D)
or else (Ekind (D) /= E_Discriminant
and then not Is_Itype (D))
N := N + 1;
end if;
- Ent := Next_Entity (Ent);
+ Next_Entity (Ent);
end loop;
return N;
Formal := First_Formal (Id);
while Present (Formal) loop
N := N + 1;
- Formal := Next_Formal (Formal);
+ Next_Formal (Formal);
end loop;
return N;
end Number_Formals;
+ ------------------------
+ -- Object_Size_Clause --
+ ------------------------
+
+ function Object_Size_Clause (Id : E) return N is
+ begin
+ return Get_Attribute_Definition_Clause (Id, Attribute_Object_Size);
+ end Object_Size_Clause;
+
--------------------
-- Parameter_Mode --
--------------------
then
Typ := Full_View (Id);
+ elsif Ekind_In (Id, E_Array_Subtype,
+ E_Record_Subtype,
+ E_Record_Subtype_With_Private)
+ and then Present (Predicated_Parent (Id))
+ then
+ Typ := Predicated_Parent (Id);
+
else
Typ := Id;
end if;
Set_First_Rep_Item (E, N);
end Record_Rep_Item;
+ -------------------
+ -- Remove_Entity --
+ -------------------
+
+ procedure Remove_Entity (Id : Entity_Id) is
+ Next : constant Entity_Id := Next_Entity (Id);
+ Prev : constant Entity_Id := Prev_Entity (Id);
+ Scop : constant Entity_Id := Scope (Id);
+ First : constant Entity_Id := First_Entity (Scop);
+ Last : constant Entity_Id := Last_Entity (Scop);
+
+ begin
+ -- Eliminate any existing linkages from the entity
+
+ Set_Prev_Entity (Id, Empty); -- Empty <-- Id
+ Set_Next_Entity (Id, Empty); -- Id --> Empty
+
+ -- The eliminated entity was the only element in the entity chain
+
+ if Id = First and then Id = Last then
+ Set_First_Entity (Scop, Empty);
+ Set_Last_Entity (Scop, Empty);
+
+ -- The eliminated entity was the head of the entity chain
+
+ elsif Id = First then
+ Set_First_Entity (Scop, Next);
+
+ -- The eliminated entity was the tail of the entity chain
+
+ elsif Id = Last then
+ Set_Last_Entity (Scop, Prev);
+
+ -- Otherwise the eliminated entity comes from the middle of the entity
+ -- chain.
+
+ else
+ Link_Entities (Prev, Next); -- Prev <-- Next, Prev --> Next
+ end if;
+ end Remove_Entity;
+
---------------
-- Root_Type --
---------------
function Underlying_Type (Id : E) return E 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
- -- doesn't make sense.
+ -- 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
+ -- sense.
if Ekind (Id) = E_Record_Type_With_Private then
return Full_View (Id);
- -- If we have a class-wide type that comes from the limited view then
- -- we return the Underlying_Type of its nonlimited view.
+ -- If we have a class-wide type that comes from the limited view then we
+ -- return the Underlying_Type of its nonlimited view.
elsif Ekind (Id) = E_Class_Wide_Type
and then From_Limited_With (Id)
elsif Ekind (Id) in Incomplete_Or_Private_Kind then
- -- If we have an incomplete or private type with a full view,
- -- then we return the Underlying_Type of this full view.
+ -- If we have an incomplete or private type with a full view, then we
+ -- return the Underlying_Type of this full view.
if Present (Full_View (Id)) then
if Id = Full_View (Id) then
elsif Etype (Id) /= Id then
return Underlying_Type (Etype (Id));
- -- Otherwise we have an incomplete or private type that has
- -- no full view, which means that we have not encountered the
- -- completion, so return Empty to indicate the underlying type
- -- is not yet known.
+ -- Otherwise we have an incomplete or private type that has no full
+ -- view, which means that we have not encountered the completion, so
+ -- return Empty to indicate the underlying type is not yet known.
else
return Empty;
end if;
end Underlying_Type;
+ ------------------------
+ -- Unlink_Next_Entity --
+ ------------------------
+
+ procedure Unlink_Next_Entity (Id : Entity_Id) is
+ Next : constant Entity_Id := Next_Entity (Id);
+
+ begin
+ if Present (Next) then
+ Set_Prev_Entity (Next, Empty); -- Empty <-- Next
+ end if;
+
+ Set_Next_Entity (Id, Empty); -- Id --> Empty
+ end Unlink_Next_Entity;
+
------------------------
-- Write_Entity_Flags --
------------------------
W ("In_Package_Body", Flag48 (Id));
W ("In_Private_Part", Flag45 (Id));
W ("In_Use", Flag8 (Id));
+ W ("Invariants_Ignored", Flag308 (Id));
W ("Is_Abstract_Subprogram", Flag19 (Id));
W ("Is_Abstract_Type", Flag146 (Id));
W ("Is_Access_Constant", Flag69 (Id));
+ W ("Is_Activation_Record", Flag305 (Id));
W ("Is_Actual_Subtype", Flag293 (Id));
W ("Is_Ada_2005_Only", Flag185 (Id));
W ("Is_Ada_2012_Only", Flag199 (Id));
W ("Is_Constr_Subt_For_U_Nominal", Flag80 (Id));
W ("Is_Constrained", Flag12 (Id));
W ("Is_Constructor", Flag76 (Id));
- W ("Is_Controlled", Flag42 (Id));
+ W ("Is_Controlled_Active", Flag42 (Id));
W ("Is_Controlling_Formal", Flag97 (Id));
W ("Is_Descendant_Of_Address", Flag223 (Id));
W ("Is_DIC_Procedure", Flag132 (Id));
W ("Is_Discriminant_Check_Function", Flag264 (Id));
W ("Is_Dispatch_Table_Entity", Flag234 (Id));
W ("Is_Dispatching_Operation", Flag6 (Id));
+ W ("Is_Elaboration_Checks_OK_Id", Flag148 (Id));
+ W ("Is_Elaboration_Warnings_OK_Id", Flag304 (Id));
W ("Is_Eliminated", Flag124 (Id));
W ("Is_Entry_Formal", Flag52 (Id));
W ("Is_Exception_Handler", Flag286 (Id));
W ("Is_Exported", Flag99 (Id));
W ("Is_Finalized_Transient", Flag252 (Id));
W ("Is_First_Subtype", Flag70 (Id));
- W ("Is_For_Access_Subtype", Flag118 (Id));
W ("Is_Formal_Subprogram", Flag111 (Id));
W ("Is_Frozen", Flag4 (Id));
W ("Is_Generic_Actual_Subprogram", Flag274 (Id));
W ("Is_Implementation_Defined", Flag254 (Id));
W ("Is_Imported", Flag24 (Id));
W ("Is_Independent", Flag268 (Id));
+ W ("Is_Initial_Condition_Procedure", Flag302 (Id));
W ("Is_Inlined", Flag11 (Id));
W ("Is_Inlined_Always", Flag1 (Id));
W ("Is_Instantiated", Flag126 (Id));
W ("Is_Limited_Interface", Flag197 (Id));
W ("Is_Limited_Record", Flag25 (Id));
W ("Is_Local_Anonymous_Access", Flag194 (Id));
+ W ("Is_Loop_Parameter", Flag307 (Id));
W ("Is_Machine_Code_Subprogram", Flag137 (Id));
W ("Is_Non_Static_Subtype", Flag109 (Id));
W ("Is_Null_Init_Proc", Flag178 (Id));
W ("May_Inherit_Delayed_Rep_Aspects", Flag262 (Id));
W ("Must_Be_On_Byte_Boundary", Flag183 (Id));
W ("Must_Have_Preelab_Init", Flag208 (Id));
+ W ("Needs_Activation_Record", Flag306 (Id));
W ("Needs_Debug_Info", Flag147 (Id));
W ("Needs_No_Actuals", Flag22 (Id));
W ("Never_Set_In_Source", Flag115 (Id));
W ("Static_Elaboration_Desired", Flag77 (Id));
W ("Stores_Attribute_Old_Prefix", Flag270 (Id));
W ("Strict_Alignment", Flag145 (Id));
- W ("Suppress_Elaboration_Warnings", Flag148 (Id));
+ W ("Suppress_Elaboration_Warnings", Flag303 (Id));
W ("Suppress_Initialization", Flag105 (Id));
W ("Suppress_Style_Checks", Flag165 (Id));
W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
Write_Eol;
Write_Attribute (" Type ", Etype (Id));
Write_Eol;
- Write_Attribute (" Scope ", Scope (Id));
+ if Id /= Standard_Standard then
+ Write_Attribute (" Scope ", Scope (Id));
+ end if;
Write_Eol;
case Ekind (Id) is
=>
Write_Str ("Component_Clause");
- when E_Function
+ when E_Entry
+ | E_Entry_Family
+ | E_Function
| E_Procedure
| E_Package
| Generic_Unit_Kind
=>
Write_Str ("Postconditions_Proc");
- when E_Generic_Package
- | E_Package
- =>
- Write_Str ("Shadow_Entities");
-
when others =>
Write_Str ("Field14??");
end case;
when E_Record_Type =>
Write_Str ("Parent_Subtype");
+ when E_Procedure =>
+ Write_Str ("Receiving_Entry");
+
when E_Constant
| E_Variable
=>
when E_Enumeration_Literal =>
Write_Str ("Enumeration_Rep_Expr");
- when E_Limited_Private_Subtype
- | E_Limited_Private_Type
- | E_Private_Subtype
- | E_Private_Type
- | E_Record_Subtype_With_Private
- | E_Record_Type_With_Private
- =>
- Write_Str ("Private_View");
-
when Formal_Kind =>
Write_Str ("Protected_Formal");
procedure Write_Field24_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
+ when E_Package =>
+ Write_Str ("Incomplete_Actuals");
+
when Type_Kind
| E_Constant
| E_Variable
=>
Write_Str ("Related_Expression");
+ when Formal_Kind =>
+ Write_Str ("Minimum_Accessibility");
+
when E_Function
| E_Operator
| E_Procedure
=>
Write_Str ("Subps_Index");
- when E_Package =>
- Write_Str ("Incomplete_Actuals");
-
when others =>
Write_Str ("Field24???");
end case;
------------------------
procedure Write_Field36_Name (Id : Entity_Id) is
+ pragma Unreferenced (Id);
begin
- case Ekind (Id) is
- when E_Variable =>
- Write_Str ("Validated_Object");
-
- when others =>
- Write_Str ("Field36??");
- end case;
+ Write_Str ("Prev_Entity");
end Write_Field36_Name;
------------------------
when E_Function
| E_Procedure
=>
- Write_Str ("class-wide clone");
+ Write_Str ("Class_Wide_Clone");
+
+ when E_Array_Subtype
+ | E_Record_Subtype
+ | E_Record_Subtype_With_Private
+ =>
+ Write_Str ("Predicated_Parent");
+
+ when E_Variable =>
+ Write_Str ("Validated_Object");
when others =>
Write_Str ("Field38??");
procedure Write_Field39_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
+ when E_Function
+ | E_Procedure
+ =>
+ Write_Str ("Protected_Subprogram");
+
when others =>
Write_Str ("Field39??");
end case;
procedure Write_Field40_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
- when E_Entry
+ when E_Abstract_State
+ | E_Constant
+ | E_Entry
| E_Entry_Family
| E_Function
| E_Generic_Function
| E_Package_Body
| E_Procedure
| E_Protected_Body
- | E_Protected_Type
| E_Subprogram_Body
| E_Task_Body
- | E_Task_Type
| E_Variable
+ | E_Void
+ | Type_Kind
=>
Write_Str ("SPARK_Pragma");
projects / thirdparty / gcc.git / blobdiff