-- Implementation of Tree Substitution Routines --
--------------------------------------------------
- -- A separate table keeps track of the mapping between rewritten nodes
- -- and their corresponding original tree nodes. Rewrite makes an entry
- -- in this table for use by Original_Node. By default, if no call is
- -- Rewrite, the entry in this table points to the original unwritten node.
+ -- A separate table keeps track of the mapping between rewritten nodes and
+ -- their corresponding original tree nodes. Rewrite makes an entry in this
+ -- table for use by Original_Node. By default the entry in this table
+ -- points to the original unwritten node. Note that if a node is rewritten
+ -- more than once, there is no easy way to get to the intermediate
+ -- rewrites; the node itself is the latest version, and the entry in this
+ -- table is the original.
- -- Note: eventually, this should be a field in the Node directly, but
- -- for now we do not want to disturb the efficiency of a power of 2
- -- for the node size. ????We are getting rid of power-of-2.
+ -- Note: This could be a node field.
package Orig_Nodes is new Table.Table (
Table_Component_Type => Node_Id,
Old_Kind : constant Entity_Kind := Ekind (Old_N);
-- If this fails, it means you need to call Reinit_Field_To_Zero before
- -- calling Set_Ekind. But we have many cases where vanishing fields are
- -- expected to reappear after converting to/from E_Void. Other cases are
- -- more problematic; set a breakpoint on "(non-E_Void case)" below.
+ -- calling Mutate_Ekind. But we have many cases where vanishing fields
+ -- are expected to reappear after converting to/from E_Void. Other cases
+ -- are more problematic; set a breakpoint on "(non-E_Void case)" below.
begin
for J in Entity_Field_Table (Old_Kind)'Range loop
procedure Set_Ekind_Type is new Set_8_Bit_Field (Entity_Kind) with Inline;
- procedure Set_Ekind
+ procedure Mutate_Ekind
(N : Entity_Id; Val : Entity_Kind)
is
begin
Set_Ekind_Type (N, Ekind_Offset, Val);
pragma Debug (Validate_Node_Write (N));
- end Set_Ekind;
+ end Mutate_Ekind;
-----------------------
-- Allocate_New_Node --
-- --
------------------------------------------------------------------------------
-with Alloc;
-with Sinfo.Nodes; use Sinfo.Nodes;
-with Einfo.Entities; use Einfo.Entities;
-with Types; use Types;
-with System; use System;
-with Table;
-with Unchecked_Conversion;
-
-package Atree is
-
-- This package defines the low-level representation of the tree used to
-- represent the Ada program internally. Syntactic and semantic information
-- is combined in this tree. There is no separate symbol table structure.
-- syntax tree format. Subsequent processing in the front end traverses the
-- tree, transforming it in various ways and adding semantic information.
- -- ????The following comments should be moved elsewhere.
-
- ----------------------------------------
- -- Definitions of fields in tree node --
- ----------------------------------------
-
- -- The representation of the tree is completely hidden, using a functional
- -- interface for accessing and modifying the contents of nodes. Logically
- -- a node contains a number of fields, much as though the nodes were
- -- defined as a record type. The fields in a node are as follows:
-
- -- Nkind Indicates the kind of the node. This field is present
- -- in all nodes. The type is Node_Kind, which is declared
- -- in the package Sinfo.
-
- -- Sloc Location (Source_Ptr) of the corresponding token
- -- in the Source buffer. The individual node definitions
- -- show which token is referenced by this pointer.
-
- -- In_List A flag used to indicate if the node is a member
- -- of a node list (see package Nlists).
-
- -- Rewrite_Ins A flag set if a node is marked as a rewrite inserted
- -- node as a result of a call to Mark_Rewrite_Insertion.
-
- -- Paren_Count A 2-bit count used in sub-expression nodes to indicate
- -- the level of parentheses. The settings are 0,1,2 and
- -- 3 for many. If the value is 3, then an auxiliary table
- -- is used to indicate the real value. Set to zero for
- -- non-subexpression nodes.
-
- -- Note: the required parentheses surrounding conditional
- -- and quantified expressions count as a level of parens
- -- for this purpose, so e.g. in X := (if A then B else C);
- -- Paren_Count for the right side will be 1.
-
- -- Comes_From_Source
- -- This flag is present in all nodes. It is set if the
- -- node is built by the scanner or parser, and clear if
- -- the node is built by the analyzer or expander. It
- -- indicates that the node corresponds to a construct
- -- that appears in the original source program.
-
- -- Analyzed This flag is present in all nodes. It is set when
- -- a node is analyzed, and is used to avoid analyzing
- -- the same node twice. Analysis includes expansion if
- -- expansion is active, so in this case if the flag is
- -- set it means the node has been analyzed and expanded.
-
- -- Error_Posted This flag is present in all nodes. It is set when
- -- an error message is posted which is associated with
- -- the flagged node. This is used to avoid posting more
- -- than one message on the same node.
-
- -- Link For a node, points to the Parent. For a list, points
- -- to the list header. Note that in the latter case, a
- -- client cannot modify the link field. This field is
- -- private to the Atree package (but is also modified
- -- by the Nlists package).
-
- -- The following additional fields are present in extended nodes used
- -- for entities (Nkind in N_Entity).
-
- -- Ekind Entity type. This field indicates the type of the
- -- entity, it is of type Entity_Kind which is defined
- -- in package Einfo.
-
- -- Convention Entity convention (Convention_Id value)
-
- -- Access to fields is generally done through the getters and setters in
- -- packages Sinfo.Nodes and Einfo.Entities. However, in specialized
- -- circumstances (examples are the circuit in generic instantiation to copy
- -- trees, and in the tree dump routine), it is useful to be able to do
- -- untyped traversals, and an internal package in Atree allows for direct
- -- untyped accesses in such cases.
+with Alloc;
+with Sinfo.Nodes; use Sinfo.Nodes;
+with Einfo.Entities; use Einfo.Entities;
+with Types; use Types;
+with System; use System;
+with Table;
+with Unchecked_Conversion;
+
+package Atree is
+
+ -- Access to node fields is generally done through the getters and setters
+ -- in packages Sinfo.Nodes and Einfo.Entities, which are automatically
+ -- generated (see Gen_IL.Gen). However, in specialized circumstances
+ -- (examples are the circuit in generic instantiation to copy trees, and in
+ -- the tree dump routine), it is useful to be able to do untyped
+ -- traversals, and an internal package in Atree allows for direct untyped
+ -- accesses in such cases.
function Last_Node_Id return Node_Id;
-- Returns Id of last allocated node Id
-- of Comes_From_Source from OldN to NewN.
procedure Change_Node (N : Node_Id; New_Kind : Node_Kind);
- -- This procedure replaces the given node by setting its Nkind field to
- -- the indicated value and resetting all other fields to their default
- -- values except for Sloc, which is unchanged, and the Parent pointer
- -- and list links, which are also unchanged. All other information in
- -- the original node is lost. The new node has an extension if the
- -- original node had an extension.????somewhat wrong.
+ -- This procedure replaces the given node by setting its Nkind field to the
+ -- indicated value and resetting all other fields to their default values
+ -- except for certain fields that are preserved (see body for details).
procedure Copy_Node (Source, Destination : Node_Or_Entity_Id);
-- Copy the entire contents of the source node to the destination node.
-- original node, i.e. the old contents of Old_Node.
procedure Replace (Old_Node, New_Node : Node_Id);
- -- This is similar to Rewrite, except that the old value of Old_Node is
- -- not saved, and the New_Node is deleted after the replace, since it
- -- In what sense is it "deleted"????
- -- is assumed that it can no longer be legitimately needed. The flag
+ -- This is similar to Rewrite, except that the old value of Old_Node
+ -- is not saved. New_Node should not be used after Replace. The flag
-- Is_Rewrite_Substitution will be False for the resulting node, unless
-- it was already true on entry, and Original_Node will not return the
- -- original contents of the Old_Node, but rather the New_Node value (unless
- -- How is this "unless" true????
- -- Old_Node had already been rewritten using Rewrite). Replace also
- -- preserves the setting of Comes_From_Source.
+ -- original contents of the Old_Node, but rather the New_Node value.
+ -- Replace also preserves the setting of Comes_From_Source.
--
- -- Note, New_Node must not contain references to Old_Node, for example as
- -- descendants, since the rewrite would make such references invalid. If
+ -- Note that New_Node must not contain references to Old_Node, for example
+ -- as descendants, since the rewrite would make such references invalid. If
-- New_Node does need to reference Old_Node, then these references should
-- be to a relocated copy of Old_Node (see Relocate_Node procedure).
--
--
-- Note: Parents are not preserved in original tree nodes that are
-- retrieved in this way (i.e. their children may have children whose
- -- pointers which reference some other node). This needs more details???
+ -- Parent pointers reference some other node).
--
-- Note: there is no direct mechanism for deleting an original node (in
-- a manner that can be reversed later). One possible approach is to use
-- vanishing fields might be used for totally unrelated fields in the new
-- node. See Reinit_Field_To_Zero.
- procedure Set_Ekind
+ procedure Mutate_Ekind
(N : Entity_Id; Val : Entity_Kind) with Inline;
- -- ????Perhaps should be called Mutate_Ekind.
- --
-- Ekind is also like a discriminant, and is mostly treated as above (see
-- Mutate_Nkind). However, there are a few cases where we set the Ekind
-- from its initial E_Void value to something else, then set it back to
-- cause our object declaration to remain unanalyzed we must do
-- some manual decoration.
- Set_Ekind (Var_Id, E_Variable);
+ Mutate_Ekind (Var_Id, E_Variable);
Set_Etype (Var_Id, Typ);
Insert_Action (Exp,
-- in its visible declarations.
if Nkind (Templ) = N_Generic_Package_Declaration then
- Set_Ekind (Templ_Id, E_Generic_Package);
+ Mutate_Ekind (Templ_Id, E_Generic_Package);
if Present (Visible_Declarations (Specification (Templ))) then
Decl := First (Visible_Declarations (Specification (Templ)));
-- declarations.
elsif Nkind (Templ) = N_Package_Body then
- Set_Ekind (Templ_Id, E_Package_Body);
+ Mutate_Ekind (Templ_Id, E_Package_Body);
if Present (Declarations (Templ)) then
Decl := First (Declarations (Templ));
elsif Nkind (Templ) = N_Generic_Subprogram_Declaration then
if Nkind (Specification (Templ)) = N_Function_Specification then
- Set_Ekind (Templ_Id, E_Generic_Function);
+ Mutate_Ekind (Templ_Id, E_Generic_Function);
else
- Set_Ekind (Templ_Id, E_Generic_Procedure);
+ Mutate_Ekind (Templ_Id, E_Generic_Procedure);
end if;
-- When the generic subprogram acts as a compilation unit, inspect
-- its declarations.
elsif Nkind (Templ) = N_Subprogram_Body then
- Set_Ekind (Templ_Id, E_Subprogram_Body);
+ Mutate_Ekind (Templ_Id, E_Subprogram_Body);
if Present (Declarations (Templ)) then
Decl := First (Declarations (Templ));
Make_Floating_Point_Definition (Stloc,
Digits_Expression => Make_Integer (UI_From_Int (Digs))));
- Set_Ekind (E, E_Floating_Point_Type);
+ Mutate_Ekind (E, E_Floating_Point_Type);
Set_Etype (E, E);
Init_Digits_Value (E, Digs);
Set_Float_Rep (E, Rep);
Low_Bound => Make_Integer (Lbound),
High_Bound => Make_Integer (Ubound)));
- Set_Ekind (E, E_Signed_Integer_Type);
+ Mutate_Ekind (E, E_Signed_Integer_Type);
Set_Etype (E, E);
Init_Size (E, Siz);
Set_Elem_Alignment (E);
begin
Set_Defining_Identifier (Decl, Uns);
- Set_Ekind (Uns, E_Modular_Integer_Type);
+ Mutate_Ekind (Uns, E_Modular_Integer_Type);
Set_Scope (Uns, Standard_Standard);
Set_Etype (Uns, Uns);
Init_Size (Uns, Siz);
procedure Build_Exception (S : Standard_Entity_Type) is
begin
- Set_Ekind (Standard_Entity (S), E_Exception);
+ Mutate_Ekind (Standard_Entity (S), E_Exception);
Set_Etype (Standard_Entity (S), Standard_Exception_Type);
Set_Is_Public (Standard_Entity (S), True);
Set_Defining_Unit_Name (Pspec, Standard_Standard);
Set_Visible_Declarations (Pspec, Decl_S);
- Set_Ekind (Standard_Standard, E_Package);
+ Mutate_Ekind (Standard_Standard, E_Package);
Set_Is_Pure (Standard_Standard);
Set_Is_Compilation_Unit (Standard_Standard);
Append (Standard_True, Literals (Tdef_Node));
Set_Type_Definition (Parent (Standard_Boolean), Tdef_Node);
- Set_Ekind (Standard_Boolean, E_Enumeration_Type);
+ Mutate_Ekind (Standard_Boolean, E_Enumeration_Type);
Set_First_Literal (Standard_Boolean, Standard_False);
Set_Etype (Standard_Boolean, Standard_Boolean);
Init_Esize (Standard_Boolean, Standard_Character_Size);
Set_Size_Known_At_Compile_Time (Standard_Boolean);
Set_Has_Pragma_Ordered (Standard_Boolean);
- Set_Ekind (Standard_True, E_Enumeration_Literal);
+ Mutate_Ekind (Standard_True, E_Enumeration_Literal);
Set_Etype (Standard_True, Standard_Boolean);
Set_Enumeration_Pos (Standard_True, Uint_1);
Set_Enumeration_Rep (Standard_True, Uint_1);
Set_Is_Known_Valid (Standard_True, True);
- Set_Ekind (Standard_False, E_Enumeration_Literal);
+ Mutate_Ekind (Standard_False, E_Enumeration_Literal);
Set_Etype (Standard_False, Standard_Boolean);
Set_Enumeration_Pos (Standard_False, Uint_0);
Set_Enumeration_Rep (Standard_False, Uint_0);
Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
Set_Type_Definition (Parent (Standard_Character), Tdef_Node);
- Set_Ekind (Standard_Character, E_Enumeration_Type);
+ Mutate_Ekind (Standard_Character, E_Enumeration_Type);
Set_Etype (Standard_Character, Standard_Character);
Init_Esize (Standard_Character, Standard_Character_Size);
Init_RM_Size (Standard_Character, 8);
Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
Set_Type_Definition (Parent (Standard_Wide_Character), Tdef_Node);
- Set_Ekind (Standard_Wide_Character, E_Enumeration_Type);
+ Mutate_Ekind (Standard_Wide_Character, E_Enumeration_Type);
Set_Etype (Standard_Wide_Character, Standard_Wide_Character);
Init_Size (Standard_Wide_Character, Standard_Wide_Character_Size);
Tdef_Node := New_Node (N_Enumeration_Type_Definition, Stloc);
Set_Type_Definition (Parent (Standard_Wide_Wide_Character), Tdef_Node);
- Set_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type);
+ Mutate_Ekind (Standard_Wide_Wide_Character, E_Enumeration_Type);
Set_Etype (Standard_Wide_Wide_Character,
Standard_Wide_Wide_Character);
Init_Size (Standard_Wide_Wide_Character,
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
- Set_Ekind (Standard_String, E_Array_Type);
+ Mutate_Ekind (Standard_String, E_Array_Type);
Set_Etype (Standard_String, Standard_String);
Set_Component_Type (Standard_String, Standard_Character);
Set_Component_Size (Standard_String, Uint_8);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
- Set_Ekind (Standard_Wide_String, E_Array_Type);
+ Mutate_Ekind (Standard_Wide_String, E_Array_Type);
Set_Etype (Standard_Wide_String, Standard_Wide_String);
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
Set_Component_Size (Standard_Wide_String, Uint_16);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
- Set_Ekind (Standard_Wide_Wide_String, E_Array_Type);
+ Mutate_Ekind (Standard_Wide_Wide_String, E_Array_Type);
Set_Etype (Standard_Wide_Wide_String,
Standard_Wide_Wide_String);
Set_Component_Type (Standard_Wide_Wide_String,
-- Setup entity for Natural
- Set_Ekind (Standard_Natural, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Standard_Natural, E_Signed_Integer_Subtype);
Set_Etype (Standard_Natural, Base_Type (Standard_Integer));
Init_Esize (Standard_Natural, Standard_Integer_Size);
Init_RM_Size (Standard_Natural, Standard_Integer_Size - 1);
-- Setup entity for Positive
- Set_Ekind (Standard_Positive, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Standard_Positive, E_Signed_Integer_Subtype);
Set_Etype (Standard_Positive, Base_Type (Standard_Integer));
Init_Esize (Standard_Positive, Standard_Integer_Size);
Init_RM_Size (Standard_Positive, Standard_Integer_Size - 1);
Set_Specification (Decl, Pspec);
Set_Defining_Unit_Name (Pspec, Standard_Entity (S_ASCII));
- Set_Ekind (Standard_Entity (S_ASCII), E_Package);
+ Mutate_Ekind (Standard_Entity (S_ASCII), E_Package);
Set_Visible_Declarations (Pspec, Decl_A);
-- Create control character definitions in package ASCII. Note that
begin
Set_Sloc (A_Char, Staloc);
- Set_Ekind (A_Char, E_Constant);
+ Mutate_Ekind (A_Char, E_Constant);
Set_Never_Set_In_Source (A_Char, True);
Set_Is_True_Constant (A_Char, True);
Set_Etype (A_Char, Standard_Character);
-- type name that is reasonable, but does not overlap any Ada name.
Standard_A_String := New_Standard_Entity ("access_string");
- Set_Ekind (Standard_A_String, E_Access_Type);
+ Mutate_Ekind (Standard_A_String, E_Access_Type);
Set_Scope (Standard_A_String, Standard_Standard);
Set_Etype (Standard_A_String, Standard_A_String);
(Standard_A_String, Standard_String);
Standard_A_Char := New_Standard_Entity ("access_character");
- Set_Ekind (Standard_A_Char, E_Access_Type);
+ Mutate_Ekind (Standard_A_Char, E_Access_Type);
Set_Scope (Standard_A_Char, Standard_Standard);
Set_Etype (Standard_A_Char, Standard_A_String);
Init_Size (Standard_A_Char, System_Address_Size);
Standard_Debug_Renaming_Type := New_Standard_Entity ("_renaming_type");
- Set_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Standard_Debug_Renaming_Type, E_Signed_Integer_Subtype);
Set_Scope (Standard_Debug_Renaming_Type, Standard_Standard);
Set_Etype (Standard_Debug_Renaming_Type, Base_Type (Standard_Integer));
Init_Esize (Standard_Debug_Renaming_Type, 0);
Build_Signed_Integer_Type (Any_Type, Standard_Integer_Size);
Any_Id := New_Standard_Entity ("any id");
- Set_Ekind (Any_Id, E_Variable);
+ Mutate_Ekind (Any_Id, E_Variable);
Set_Scope (Any_Id, Standard_Standard);
Set_Etype (Any_Id, Any_Type);
Init_Esize (Any_Id);
Init_Alignment (Any_Id);
Any_Access := New_Standard_Entity ("an access type");
- Set_Ekind (Any_Access, E_Access_Type);
+ Mutate_Ekind (Any_Access, E_Access_Type);
Set_Scope (Any_Access, Standard_Standard);
Set_Etype (Any_Access, Any_Access);
Init_Size (Any_Access, System_Address_Size);
(Any_Access, Any_Type);
Any_Character := New_Standard_Entity ("a character type");
- Set_Ekind (Any_Character, E_Enumeration_Type);
+ Mutate_Ekind (Any_Character, E_Enumeration_Type);
Set_Scope (Any_Character, Standard_Standard);
Set_Etype (Any_Character, Any_Character);
Set_Is_Unsigned_Type (Any_Character);
Set_Scalar_Range (Any_Character, Scalar_Range (Standard_Character));
Any_Array := New_Standard_Entity ("an array type");
- Set_Ekind (Any_Array, E_Array_Type);
+ Mutate_Ekind (Any_Array, E_Array_Type);
Set_Scope (Any_Array, Standard_Standard);
Set_Etype (Any_Array, Any_Array);
Set_Component_Type (Any_Array, Any_Character);
Make_Dummy_Index (Any_Array);
Any_Boolean := New_Standard_Entity ("a boolean type");
- Set_Ekind (Any_Boolean, E_Enumeration_Type);
+ Mutate_Ekind (Any_Boolean, E_Enumeration_Type);
Set_Scope (Any_Boolean, Standard_Standard);
Set_Etype (Any_Boolean, Standard_Boolean);
Init_Esize (Any_Boolean, Standard_Character_Size);
Set_Scalar_Range (Any_Boolean, Scalar_Range (Standard_Boolean));
Any_Composite := New_Standard_Entity ("a composite type");
- Set_Ekind (Any_Composite, E_Array_Type);
+ Mutate_Ekind (Any_Composite, E_Array_Type);
Set_Scope (Any_Composite, Standard_Standard);
Set_Etype (Any_Composite, Any_Composite);
Set_Component_Size (Any_Composite, Uint_0);
Init_Size_Align (Any_Composite);
Any_Discrete := New_Standard_Entity ("a discrete type");
- Set_Ekind (Any_Discrete, E_Signed_Integer_Type);
+ Mutate_Ekind (Any_Discrete, E_Signed_Integer_Type);
Set_Scope (Any_Discrete, Standard_Standard);
Set_Etype (Any_Discrete, Any_Discrete);
Init_Size (Any_Discrete, Standard_Integer_Size);
Set_Elem_Alignment (Any_Discrete);
Any_Fixed := New_Standard_Entity ("a fixed-point type");
- Set_Ekind (Any_Fixed, E_Ordinary_Fixed_Point_Type);
+ Mutate_Ekind (Any_Fixed, E_Ordinary_Fixed_Point_Type);
Set_Scope (Any_Fixed, Standard_Standard);
Set_Etype (Any_Fixed, Any_Fixed);
Init_Size (Any_Fixed, Standard_Integer_Size);
Set_Elem_Alignment (Any_Fixed);
Any_Integer := New_Standard_Entity ("an integer type");
- Set_Ekind (Any_Integer, E_Signed_Integer_Type);
+ Mutate_Ekind (Any_Integer, E_Signed_Integer_Type);
Set_Scope (Any_Integer, Standard_Standard);
Set_Etype (Any_Integer, Standard_Long_Long_Long_Integer);
Init_Size (Any_Integer, Standard_Long_Long_Long_Integer_Size);
Hb => Intval (High_Bound (Scalar_Range (Standard_Integer))));
Any_Modular := New_Standard_Entity ("a modular type");
- Set_Ekind (Any_Modular, E_Modular_Integer_Type);
+ Mutate_Ekind (Any_Modular, E_Modular_Integer_Type);
Set_Scope (Any_Modular, Standard_Standard);
Set_Etype (Any_Modular, Standard_Long_Long_Long_Integer);
Init_Size (Any_Modular, Standard_Long_Long_Long_Integer_Size);
Set_Is_Unsigned_Type (Any_Modular);
Any_Numeric := New_Standard_Entity ("a numeric type");
- Set_Ekind (Any_Numeric, E_Signed_Integer_Type);
+ Mutate_Ekind (Any_Numeric, E_Signed_Integer_Type);
Set_Scope (Any_Numeric, Standard_Standard);
Set_Etype (Any_Numeric, Standard_Long_Long_Long_Integer);
Init_Size (Any_Numeric, Standard_Long_Long_Long_Integer_Size);
Set_Elem_Alignment (Any_Numeric);
Any_Real := New_Standard_Entity ("a real type");
- Set_Ekind (Any_Real, E_Floating_Point_Type);
+ Mutate_Ekind (Any_Real, E_Floating_Point_Type);
Set_Scope (Any_Real, Standard_Standard);
Set_Etype (Any_Real, Standard_Long_Long_Float);
Init_Size (Any_Real,
Set_Elem_Alignment (Any_Real);
Any_Scalar := New_Standard_Entity ("a scalar type");
- Set_Ekind (Any_Scalar, E_Signed_Integer_Type);
+ Mutate_Ekind (Any_Scalar, E_Signed_Integer_Type);
Set_Scope (Any_Scalar, Standard_Standard);
Set_Etype (Any_Scalar, Any_Scalar);
Init_Size (Any_Scalar, Standard_Integer_Size);
Set_Elem_Alignment (Any_Scalar);
Any_String := New_Standard_Entity ("a string type");
- Set_Ekind (Any_String, E_Array_Type);
+ Mutate_Ekind (Any_String, E_Array_Type);
Set_Scope (Any_String, Standard_Standard);
Set_Etype (Any_String, Any_String);
Set_Component_Type (Any_String, Any_Character);
Universal_Fixed := New_Standard_Entity ("universal_fixed");
Decl := New_Node (N_Full_Type_Declaration, Stloc);
Set_Defining_Identifier (Decl, Universal_Fixed);
- Set_Ekind (Universal_Fixed, E_Ordinary_Fixed_Point_Type);
+ Mutate_Ekind (Universal_Fixed, E_Ordinary_Fixed_Point_Type);
Set_Etype (Universal_Fixed, Universal_Fixed);
Set_Scope (Universal_Fixed, Standard_Standard);
Init_Size (Universal_Fixed, Standard_Long_Long_Integer_Size);
Set_Type_Definition (Parent (Standard_Duration), Tdef_Node);
- Set_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
+ Mutate_Ekind (Standard_Duration, E_Ordinary_Fixed_Point_Type);
Set_Etype (Standard_Duration, Standard_Duration);
if Duration_32_Bits_On_Target then
begin
Standard_Exception_Type := New_Standard_Entity ("exception");
- Set_Ekind (Standard_Exception_Type, E_Record_Type);
+ Mutate_Ekind (Standard_Exception_Type, E_Record_Type);
Set_Etype (Standard_Exception_Type, Standard_Exception_Type);
Set_Scope (Standard_Exception_Type, Standard_Standard);
Set_Stored_Constraint
Decl := New_Node (N_Exception_Renaming_Declaration, Stloc);
E_Id := Standard_Entity (S_Numeric_Error);
- Set_Ekind (E_Id, E_Exception);
+ Mutate_Ekind (E_Id, E_Exception);
Set_Etype (E_Id, Standard_Exception_Type);
Set_Is_Public (E_Id);
Set_Renamed_Entity (E_Id, Standard_Entity (S_Constraint_Error));
Abort_Signal := New_Standard_Entity;
Set_Chars (Abort_Signal, Name_uAbort_Signal);
- Set_Ekind (Abort_Signal, E_Exception);
+ Mutate_Ekind (Abort_Signal, E_Exception);
Set_Etype (Abort_Signal, Standard_Exception_Type);
Set_Scope (Abort_Signal, Standard_Standard);
Set_Is_Public (Abort_Signal, True);
Standard_Op_Rotate_Left := New_Standard_Entity;
Set_Chars (Standard_Op_Rotate_Left, Name_Rotate_Left);
- Set_Ekind (Standard_Op_Rotate_Left, E_Operator);
+ Mutate_Ekind (Standard_Op_Rotate_Left, E_Operator);
Standard_Op_Rotate_Right := New_Standard_Entity;
Set_Chars (Standard_Op_Rotate_Right, Name_Rotate_Right);
- Set_Ekind (Standard_Op_Rotate_Right, E_Operator);
+ Mutate_Ekind (Standard_Op_Rotate_Right, E_Operator);
Standard_Op_Shift_Left := New_Standard_Entity;
Set_Chars (Standard_Op_Shift_Left, Name_Shift_Left);
- Set_Ekind (Standard_Op_Shift_Left, E_Operator);
+ Mutate_Ekind (Standard_Op_Shift_Left, E_Operator);
Standard_Op_Shift_Right := New_Standard_Entity;
Set_Chars (Standard_Op_Shift_Right, Name_Shift_Right);
- Set_Ekind (Standard_Op_Shift_Right, E_Operator);
+ Mutate_Ekind (Standard_Op_Shift_Right, E_Operator);
Standard_Op_Shift_Right_Arithmetic := New_Standard_Entity;
Set_Chars (Standard_Op_Shift_Right_Arithmetic,
Name_Shift_Right_Arithmetic);
- Set_Ekind (Standard_Op_Shift_Right_Arithmetic,
+ Mutate_Ekind (Standard_Op_Shift_Right_Arithmetic,
E_Operator);
-- Create standard operator declarations
New_Ent : constant Entity_Id := New_Copy (E);
begin
- Set_Ekind (E, K);
+ Mutate_Ekind (E, K);
Set_Is_Constrained (E, True);
Set_Is_First_Subtype (E, True);
Set_Etype (E, New_Ent);
Id : constant Entity_Id := New_Standard_Entity (Nam);
begin
- Set_Ekind (Id, E_Component);
+ Mutate_Ekind (Id, E_Component);
Set_Etype (Id, Typ);
Set_Scope (Id, Rec);
Init_Component_Location (Id);
Formal : constant Entity_Id := New_Standard_Entity (Nam);
begin
- Set_Ekind (Formal, E_In_Parameter);
+ Mutate_Ekind (Formal, E_In_Parameter);
Set_Mechanism (Formal, Default_Mechanism);
Set_Scope (Formal, Standard_Standard);
Set_Etype (Formal, Typ);
begin
Set_Is_Pure (Ident_Node, True);
- Set_Ekind (Ident_Node, E_Operator);
+ Mutate_Ekind (Ident_Node, E_Operator);
Set_Etype (Ident_Node, Typ);
Set_Scope (Ident_Node, Standard_Standard);
Set_Homonym (Ident_Node, Get_Name_Entity_Id (Op));
package Einfo is
--- ????Comments below are partly obsolete
+-- This package documents the annotations to the abstract syntax tree that are
+-- needed to support semantic processing of an Ada compilation.
--- This package defines the annotations to the abstract syntax tree that
--- are needed to support semantic processing of an Ada compilation.
-
--- Note that after editing this spec and the corresponding body it is
--- required to run ceinfo to check the consistentcy of spec and body.
--- See ceinfo.adb for more information about the checks made.
+-- See the spec of Gen_IL.Gen for instructions on making changes to this file.
+-- Note that the official definition of what entities have what fields is in
+-- Gen_IL.Gen.Gen_Entities; if there is a discrepancy between that and the
+-- comments here, Gen_IL.Gen.Gen_Entities wins.
+--
+-- Offsets of each field are given in parentheses below, but this information
+-- is obsolete, and should be completely ignored. The actual field offsets are
+-- determined by the Gen_IL program. We might want to remove these comments at
+-- some point.
-- These annotations are for the most part attributes of declared entities,
-- and they correspond to conventional symbol table information. Other
-- attributes include sets of meanings for overloaded names, possible
-- types for overloaded expressions, flags to indicate deferred constants,
--- incomplete types, etc. These attributes are stored in available fields in
--- tree nodes (i.e. fields not used by the parser, as defined by the Sinfo
--- package specification), and accessed by means of a set of subprograms
--- which define an abstract interface.
+-- incomplete types, etc. These attributes are stored in fields in
+-- tree nodes.
-- There are two kinds of semantic information
-- Second, in some cases semantic information is stored directly in other
-- kinds of nodes, e.g. the Etype field, used to indicate the type of an
--- expression. The access functions to these fields are defined in the
--- Sinfo package, but their full documentation is to be found in
--- the Einfo package specification.
+-- expression. These fields are defined in the Sinfo package, but their
+-- full documentation is in the Einfo package specification.
-- Declaration processing places information in the nodes of their defining
-- identifiers. Name resolution places in all other occurrences of an
-- identifier a pointer to the corresponding defining occurrence.
---------------------------------
--- The XEINFO Utility Program --
---------------------------------
-
--- XEINFO is a utility program which automatically produces a C header file,
--- einfo.h from the spec and body of package Einfo. It reads the input files
--- einfo.ads and einfo.adb and produces the output file einfo.h. XEINFO is run
--- automatically by the build scripts when you do a full bootstrap.
-
--- In order for this utility program to operate correctly, the form of the
--- einfo.ads and einfo.adb files must meet certain requirements and be laid
--- out in a specific manner.
-
--- The general form of einfo.ads is as follows:
-
--- type declaration for type Entity_Kind
--- subtype declarations declaring subranges of Entity_Kind
--- subtype declarations declaring synonyms for some standard types
--- function specs for attributes
--- procedure specs
--- pragma Inline declarations
-
--- This order must be observed. There are no restrictions on the procedures,
--- since the C header file only includes functions (The back end is not
--- allowed to modify the generated tree). However, functions are required to
--- have headers that fit on a single line.
-
--- XEINFO reads and processes the function specs and the pragma Inlines. For
--- functions that are declared as inlined, XEINFO reads the corresponding body
--- from einfo.adb, and processes it into C code. This results in some strict
--- restrictions on which functions can be inlined:
-
--- The function spec must be on a single line
-
--- There can only be a single return statement, not counting any pragma
--- Assert statements, possibly followed by a comment.
-
--- This single statement must either contain a function call with simple,
--- single token arguments, or it must contain a membership test of the form
--- a in b, where a and b are single tokens, or it must contain an equality
--- or inequality test of single tokens, or it must contain a disjunction of
--- the preceding constructs.
-
--- For functions that are not inlined, there is no restriction on the body,
--- and XEINFO generates a direct reference in the C header file which allows
--- the C code in the backend to directly call the corresponding Ada body.
-
----------------------------------
-- Handling of Type'Size Values --
----------------------------------
-- aggregate. If the declaration has a subtype mark, use it,
-- otherwise use the itype of the aggregate.
- Set_Ekind (Tmp, E_Variable);
+ Mutate_Ekind (Tmp, E_Variable);
if not Is_Constrained (Typ) then
Build_Constrained_Type (Positional => False);
-- type Res_Typ is access all Comp_Typ;
Res_Typ := Make_Temporary (Loc, 'A');
- Set_Ekind (Res_Typ, E_General_Access_Type);
+ Mutate_Ekind (Res_Typ, E_General_Access_Type);
Set_Directly_Designated_Type (Res_Typ, Comp_Typ);
Add_Item
-- its lifetime is bounded by the current array or record component.
Res_Id := Make_Temporary (Loc, 'R');
- Set_Ekind (Res_Id, E_Constant);
+ Mutate_Ekind (Res_Id, E_Constant);
Set_Etype (Res_Id, Res_Typ);
-- Mark the transient object as successfully processed to avoid double
-- Stmts
-- end Func_Id;
- Set_Ekind (Func_Id, E_Function);
+ Mutate_Ekind (Func_Id, E_Function);
Set_Is_Internal (Func_Id);
Set_Is_Pure (Func_Id);
-- Stmts
-- end Func_Id;
- Set_Ekind (Func_Id, E_Function);
+ Mutate_Ekind (Func_Id, E_Function);
Set_Is_Internal (Func_Id);
Set_Is_Pure (Func_Id);
-- Set the entity kind now in order to mark the temporary as a
-- handler of attribute 'Old's prefix.
- Set_Ekind (Temp, E_Constant);
+ Mutate_Ekind (Temp, E_Constant);
Set_Stores_Attribute_Old_Prefix (Temp);
-- Push the scope of the related subprogram where _Postcondition
if No (Choice_Parameter (Ehand)) then
E := Make_Temporary (Loc, 'E');
Set_Choice_Parameter (Ehand, E);
- Set_Ekind (E, E_Variable);
+ Mutate_Ekind (E, E_Variable);
Set_Etype (E, RTE (RE_Exception_Occurrence));
Set_Scope (E, Current_Scope);
end if;
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Body_Stmts)));
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Is_Public (Proc_Id, Is_Public (A_Type));
Set_Is_Internal (Proc_Id);
Set_Has_Completion (Proc_Id);
Statements => New_List (
Build_Case_Statement (Case_Id, Variant))));
- Set_Ekind (Func_Id, E_Function);
+ Mutate_Ekind (Func_Id, E_Function);
Set_Mechanism (Func_Id, Default_Mechanism);
Set_Is_Inlined (Func_Id, True);
Set_Is_Pure (Func_Id, True);
New_Occurrence_Of (Iface_Comp, Loc)),
Attribute_Name => Name_Position))))));
- Set_Ekind (Func_Id, E_Function);
+ Mutate_Ekind (Func_Id, E_Function);
Set_Mechanism (Func_Id, Default_Mechanism);
Set_Is_Internal (Func_Id, True);
Make_Defining_Identifier (Loc,
Chars => Make_TSS_Name (Rec_Type, TSS_CPP_Init_Proc));
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Is_Internal (Proc_Id);
Set_Defining_Unit_Name (Proc_Spec_Node, Proc_Id);
begin
Body_Stmts := New_List;
Body_Node := New_Node (N_Subprogram_Body, Loc);
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Proc_Spec_Node := New_Node (N_Procedure_Specification, Loc);
Set_Defining_Unit_Name (Proc_Spec_Node, Proc_Id);
Link_Entities (New_Id, Next_Entity (Def_Id));
Link_Entities (Def_Id, Next_Temp);
- Set_Chars (Defining_Identifier (N), Chars (Def_Id));
+ Set_Chars (Defining_Identifier (N), Chars (Def_Id));
Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
- Set_Ekind (Defining_Identifier (N), Ekind (Def_Id));
- Set_Sloc (Defining_Identifier (N), Sloc (Def_Id));
+ Mutate_Ekind (Defining_Identifier (N), Ekind (Def_Id));
+ Set_Sloc (Defining_Identifier (N), Sloc (Def_Id));
Set_Comes_From_Source (Def_Id, False);
Level_Expr : Node_Id;
begin
- Set_Ekind (Level, Ekind (Def_Id));
+ Mutate_Ekind (Level, Ekind (Def_Id));
Set_Etype (Level, Standard_Natural);
Set_Scope (Level, Scope (Def_Id));
-- primitive operations list. We add the minimum decoration needed
-- to override interface primitives.
- Set_Ekind (Defining_Unit_Name (Func_Spec), E_Function);
+ Mutate_Ekind (Defining_Unit_Name (Func_Spec), E_Function);
Override_Dispatching_Operation
(Tag_Typ, Subp, New_Op => Defining_Unit_Name (Func_Spec),
Analyze (Init_Decl);
Init_Name := Defining_Identifier (Init_Decl);
- Set_Ekind (Init_Name, E_Loop_Parameter);
+ Mutate_Ekind (Init_Name, E_Loop_Parameter);
-- The cursor was marked as a loop parameter to prevent user assignments
-- to it, however this renders the advancement step illegal as it is not
(N, Container, Cursor, Init, Advance, New_Loop);
Append_To (Stats, Advance);
- Set_Ekind (Cursor, E_Variable);
+ Mutate_Ekind (Cursor, E_Variable);
Insert_Action (N, Init);
-- The loop parameter is declared by an object declaration, but within
(Container_Typ, Aspect_Variable_Indexing))
or else not Is_Variable (Original_Node (Container))
then
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
end if;
Prepend_To (Stats, Decl);
Set_Assignment_OK (Cursor_Decl);
Insert_Action (N, Cursor_Decl);
- Set_Ekind (Cursor, Id_Kind);
+ Mutate_Ekind (Cursor, Id_Kind);
end;
-- If the range of iteration is given by a function call that returns
-- identifier, since there may be references in the loop body.
Set_Analyzed (Loop_Id, False);
- Set_Ekind (Loop_Id, E_Variable);
+ Mutate_Ekind (Loop_Id, E_Variable);
-- In most loops the loop variable is assigned in various
-- alternatives in the body. However, in the rare case when
-- Perform minor decoration in order to set the master and the
-- storage pool attributes.
- Set_Ekind (Ptr_Typ, E_Access_Type);
+ Mutate_Ekind (Ptr_Typ, E_Access_Type);
Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
Temp : Entity_Id;
begin
- Set_Ekind (Acc_Typ, E_Access_Type);
+ Mutate_Ekind (Acc_Typ, E_Access_Type);
Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
-- Perform minor decoration in order to set the master and the
-- storage pool attributes.
- Set_Ekind (Ptr_Typ, E_Access_Type);
+ Mutate_Ekind (Ptr_Typ, E_Access_Type);
Set_Finalization_Master (Ptr_Typ, Fin_Mas_Id);
Set_Associated_Storage_Pool (Ptr_Typ, Pool_Id);
Set_Debug_Info_Needed (New_F);
if Ekind (Formal) = E_In_Parameter then
- Set_Ekind (New_F, E_Constant);
+ Mutate_Ekind (New_F, E_Constant);
else
- Set_Ekind (New_F, E_Variable);
+ Mutate_Ekind (New_F, E_Variable);
Set_Extra_Constrained (New_F, Extra_Constrained (Formal));
end if;
begin
Set_Corresponding_Record_Type (Ctyp, Rec_Ent);
- Set_Ekind (Rec_Ent, E_Record_Type);
+ Mutate_Ekind (Rec_Ent, E_Record_Type);
Set_Has_Delayed_Freeze (Rec_Ent, Has_Delayed_Freeze (Ctyp));
Set_Is_Concurrent_Record_Type (Rec_Ent, True);
Set_Corresponding_Concurrent_Type (Rec_Ent, Ctyp);
-- Sem_Ch6.Override_Dispatching_Operation.
if Ekind (Subp_Id) = E_Function then
- Set_Ekind (Wrapper_Id, E_Function);
+ Mutate_Ekind (Wrapper_Id, E_Function);
else
- Set_Ekind (Wrapper_Id, E_Procedure);
+ Mutate_Ekind (Wrapper_Id, E_Procedure);
end if;
Set_Is_Primitive_Wrapper (Wrapper_Id);
if Unprotected then
Set_Protected_Formal (Formal, Defining_Identifier (New_Param));
- Set_Ekind (Defining_Identifier (New_Param), Ekind (Formal));
+ Mutate_Ekind (Defining_Identifier (New_Param), Ekind (Formal));
end if;
Append (New_Param, New_Plist);
-- Sem_Ch4.Names_Match).
if Mode = Dispatching_Mode then
- Set_Ekind (New_Id, Ekind (Def_Id));
+ Mutate_Ekind (New_Id, Ekind (Def_Id));
Set_Original_Protected_Subprogram (New_Id, Def_Id);
end if;
-- Link the protected or unprotected version to the original subprogram
-- it emulates.
- Set_Ekind (New_Id, Ekind (Def_Id));
+ Mutate_Ekind (New_Id, Ekind (Def_Id));
Set_Protected_Subprogram (New_Id, Def_Id);
-- The unprotected operation carries the user code, and debugging
Set_Debug_Info_Needed (New_F);
if Ekind (Formal) = E_In_Parameter then
- Set_Ekind (New_F, E_Constant);
+ Mutate_Ekind (New_F, E_Constant);
else
- Set_Ekind (New_F, E_Variable);
+ Mutate_Ekind (New_F, E_Variable);
Set_Extra_Constrained (New_F, Extra_Constrained (Formal));
end if;
-- statement if any to initialize the declarations of the block.
Blkent := Make_Temporary (Loc, 'A');
- Set_Ekind (Blkent, E_Block);
+ Mutate_Ekind (Blkent, E_Block);
Set_Etype (Blkent, Standard_Void_Type);
Set_Scope (Blkent, Current_Scope);
-- Link the acceptor to the original receiving entry
- Set_Ekind (PB_Ent, E_Procedure);
+ Mutate_Ekind (PB_Ent, E_Procedure);
Set_Receiving_Entry (PB_Ent, Eent);
if Comes_From_Source (Alt) then
-- Minimal decoration
if Ekind (Spec_Id) = E_Function then
- Set_Ekind (Decl_Id, E_Constant);
+ Mutate_Ekind (Decl_Id, E_Constant);
else
- Set_Ekind (Decl_Id, E_Variable);
+ Mutate_Ekind (Decl_Id, E_Variable);
end if;
Set_Prival (Comp_Id, Decl_Id);
begin
-- Minimal decoration
- Set_Ekind (Index_Con, E_Constant);
+ Mutate_Ekind (Index_Con, E_Constant);
Set_Entry_Index_Constant (Index, Index_Con);
Set_Discriminal_Link (Index_Con, Index);
Make_Defining_Identifier (Sloc (D),
Chars => New_External_Name (Chars (D), 'D'));
- Set_Ekind (D_Minal, E_Constant);
+ Mutate_Ekind (D_Minal, E_Constant);
Set_Etype (D_Minal, Etype (D));
Set_Scope (D_Minal, Pdef);
Set_Discriminal (D, D_Minal);
-- with GNATcoverage, as that tool relies on it to identify
-- thunks and exclude them from source coverage analysis.
- Set_Ekind (Thunk_Id, Ekind (Prim));
+ Mutate_Ekind (Thunk_Id, Ekind (Prim));
Set_Is_Thunk (Thunk_Id);
Set_Convention (Thunk_Id, Convention (Prim));
Set_Needs_Debug_Info (Thunk_Id, Needs_Debug_Info (Target));
-- dispatch tables.
if not Building_Static_DT (Typ) then
- Set_Ekind (Predef_Prims, E_Variable);
- Set_Ekind (Iface_DT, E_Variable);
+ Mutate_Ekind (Predef_Prims, E_Variable);
+ Mutate_Ekind (Iface_DT, E_Variable);
-- Statically allocated dispatch tables and related entities are
-- constants.
else
- Set_Ekind (Predef_Prims, E_Constant);
+ Mutate_Ekind (Predef_Prims, E_Constant);
Set_Is_Statically_Allocated (Predef_Prims);
Set_Is_True_Constant (Predef_Prims);
- Set_Ekind (Iface_DT, E_Constant);
+ Mutate_Ekind (Iface_DT, E_Constant);
Set_Is_Statically_Allocated (Iface_DT);
Set_Is_True_Constant (Iface_DT);
end if;
-- objects by making them volatile.
Set_Is_Imported (Dummy_Object);
- Set_Ekind (Dummy_Object, E_Constant);
+ Mutate_Ekind (Dummy_Object, E_Constant);
Set_Is_True_Constant (Dummy_Object);
Set_Related_Type (Dummy_Object, Typ);
begin
Set_Is_Imported (DT);
- Set_Ekind (DT, E_Constant);
+ Mutate_Ekind (DT, E_Constant);
Set_Related_Type (DT, Typ);
-- The scope must be set now to call Get_External_Name
-- Minimum decoration
- Set_Ekind (DT_Ptr, E_Variable);
+ Mutate_Ekind (DT_Ptr, E_Variable);
Set_Related_Type (DT_Ptr, Typ);
-- Notify back end that the types are associated with a dispatch table
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Typ_Name, 'P'));
Set_Etype (Iface_DT_Ptr, RTE (RE_Interface_Tag));
- Set_Ekind (Iface_DT_Ptr, E_Variable);
+ Mutate_Ekind (Iface_DT_Ptr, E_Variable);
Set_Is_Tag (Iface_DT_Ptr);
Set_Has_Thunks (Iface_DT_Ptr);
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Typ_Name, 'P'));
Set_Etype (Iface_DT_Ptr, RTE (RE_Interface_Tag));
- Set_Ekind (Iface_DT_Ptr, E_Constant);
+ Mutate_Ekind (Iface_DT_Ptr, E_Constant);
Set_Is_Tag (Iface_DT_Ptr);
Set_Has_Thunks (Iface_DT_Ptr);
Set_Is_Statically_Allocated (Iface_DT_Ptr,
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Typ_Name, 'Y'));
Set_Etype (Iface_DT_Ptr, RTE (RE_Address));
- Set_Ekind (Iface_DT_Ptr, E_Constant);
+ Mutate_Ekind (Iface_DT_Ptr, E_Constant);
Set_Is_Tag (Iface_DT_Ptr);
Set_Has_Thunks (Iface_DT_Ptr);
Set_Is_Statically_Allocated (Iface_DT_Ptr,
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Typ_Name, 'D'));
Set_Etype (Iface_DT_Ptr, RTE (RE_Interface_Tag));
- Set_Ekind (Iface_DT_Ptr, E_Constant);
+ Mutate_Ekind (Iface_DT_Ptr, E_Constant);
Set_Is_Tag (Iface_DT_Ptr);
Set_Is_Statically_Allocated (Iface_DT_Ptr,
Is_Library_Level_Tagged_Type (Typ));
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Typ_Name, 'Z'));
Set_Etype (Iface_DT_Ptr, RTE (RE_Address));
- Set_Ekind (Iface_DT_Ptr, E_Constant);
+ Mutate_Ekind (Iface_DT_Ptr, E_Constant);
Set_Is_Tag (Iface_DT_Ptr);
Set_Is_Statically_Allocated (Iface_DT_Ptr,
Is_Library_Level_Tagged_Type (Typ));
end if;
if Is_CPP_Class (Root_Type (Typ)) then
- Set_Ekind (DT_Ptr, E_Variable);
+ Mutate_Ekind (DT_Ptr, E_Variable);
else
- Set_Ekind (DT_Ptr, E_Constant);
+ Mutate_Ekind (DT_Ptr, E_Constant);
end if;
Set_Is_Tag (DT_Ptr);
New_Occurrence_Of (
Entity (Result_Definition (Spec)), Loc));
- Set_Ekind (Proc, E_Function);
+ Mutate_Ekind (Proc, E_Function);
Set_Etype (Proc,
New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc));
Defining_Unit_Name => Proc,
Parameter_Specifications => Param_Specs);
- Set_Ekind (Proc, E_Procedure);
+ Mutate_Ekind (Proc, E_Procedure);
Set_Etype (Proc, Standard_Void_Type);
end if;
Existing := False;
Stub_Type := Make_Temporary (Loc, 'S');
- Set_Ekind (Stub_Type, E_Record_Type);
+ Mutate_Ekind (Stub_Type, E_Record_Type);
Set_Is_RACW_Stub_Type (Stub_Type);
Stub_Type_Access :=
Make_Defining_Identifier (Loc,
Object_Definition =>
New_Occurrence_Of
(Defining_Identifier (Last (Decls)), Loc)));
- Set_Ekind (Object, E_Variable);
+ Mutate_Ekind (Object, E_Variable);
-- Suppress default initialization:
-- pragma Import (Ada, Object);
Expression => Expr));
if Constant_Present (Last (Decls)) then
- Set_Ekind (Object, E_Constant);
+ Mutate_Ekind (Object, E_Constant);
else
- Set_Ekind (Object, E_Variable);
+ Mutate_Ekind (Object, E_Variable);
end if;
end if;
end Build_Actual_Object_Declaration;
-- Set the kind and return type of the function to prevent
-- ambiguities between Ras_Type and Fat_Type in subsequent analysis.
- Set_Ekind (Proc, E_Function);
+ Mutate_Ekind (Proc, E_Function);
Set_Etype (Proc, Fat_Type);
Discard_Node (
-- Set the kind and return type of the function to prevent
-- ambiguities between Ras_Type and Fat_Type in subsequent analysis.
- Set_Ekind (Proc, E_Function);
+ Mutate_Ekind (Proc, E_Function);
Set_Etype (Proc, Fat_Type);
Discard_Node (
begin
if Nkind (Spec) = N_Function_Specification then
- Set_Ekind (Snam, E_Function);
+ Mutate_Ekind (Snam, E_Function);
Set_Etype (Snam, Entity (Result_Definition (Spec)));
else
- Set_Ekind (Snam, E_Procedure);
+ Mutate_Ekind (Snam, E_Procedure);
Set_Etype (Snam, Standard_Void_Type);
end if;
H_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (E), 'H'));
- Set_Ekind (H_Id, E_Function);
+ Mutate_Ekind (H_Id, E_Function);
Set_Is_Internal (H_Id);
if not Debug_Generated_Code then
if No (Choice_Parameter (P)) then
E := Make_Temporary (Loc, 'E');
Set_Choice_Parameter (P, E);
- Set_Ekind (E, E_Variable);
+ Mutate_Ekind (E, E_Variable);
Set_Etype (E, RTE (RE_Exception_Occurrence));
Set_Scope (E, Current_Scope);
end if;
-- effects). Assign prefix value to temp on Eval_Statement
-- list, so assignment will be executed conditionally.
- Set_Ekind (Temp, E_Variable);
+ Mutate_Ekind (Temp, E_Variable);
Set_Suppress_Initialization (Temp);
Analyze (Decl);
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Pack_Id), "Initial_Condition"));
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Is_Initial_Condition_Procedure (Proc_Id);
-- Generate:
begin
Typ := Make_Temporary (Loc, 'S');
- Set_Ekind (Typ, E_General_Access_Type);
+ Mutate_Ekind (Typ, E_General_Access_Type);
Set_Etype (Typ, Typ);
Set_Scope (Typ, Scop);
Set_Directly_Designated_Type (Typ, Etype (E));
-- Decorate the new formal entity
Set_Scope (Form, STJ.Ent);
- Set_Ekind (Form, E_In_Parameter);
+ Mutate_Ekind (Form, E_In_Parameter);
Set_Etype (Form, STJE.ARECnPT);
Set_Mechanism (Form, By_Copy);
Set_Never_Set_In_Source (Form, True);
-- Perform minor decoration in case the body is not analyzed
- Set_Ekind (Proc_Body_Id, E_Subprogram_Body);
+ Mutate_Ekind (Proc_Body_Id, E_Subprogram_Body);
Set_Etype (Proc_Body_Id, Standard_Void_Type);
Set_Scope (Proc_Body_Id, Current_Scope);
Set_SPARK_Pragma (Proc_Body_Id, SPARK_Pragma (Proc_Id));
-- Perform minor decoration in case the declaration is not analyzed
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Etype (Proc_Id, Standard_Void_Type);
Set_Is_DIC_Procedure (Proc_Id);
Set_Scope (Proc_Id, Current_Scope);
-- Perform minor decoration in case the declaration is not analyzed
- Set_Ekind (Obj_Id, E_In_Parameter);
+ Mutate_Ekind (Obj_Id, E_In_Parameter);
Set_Etype (Obj_Id, Work_Typ);
Set_Scope (Obj_Id, Proc_Id);
-- Perform minor decoration in case the body is not analyzed
- Set_Ekind (Proc_Body_Id, E_Subprogram_Body);
+ Mutate_Ekind (Proc_Body_Id, E_Subprogram_Body);
Set_Etype (Proc_Body_Id, Standard_Void_Type);
Set_Scope (Proc_Body_Id, Current_Scope);
-- Perform minor decoration in case the declaration is not analyzed
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Etype (Proc_Id, Standard_Void_Type);
Set_Scope (Proc_Id, Current_Scope);
-- Perform minor decoration in case the declaration is not analyzed
- Set_Ekind (Obj_Id, E_In_Parameter);
+ Mutate_Ekind (Obj_Id, E_In_Parameter);
Set_Etype (Obj_Id, Obj_Typ);
Set_Scope (Obj_Id, Proc_Id);
-- type Ptr_Typ is access all Desig_Typ;
Ptr_Typ := Make_Temporary (Loc, 'A');
- Set_Ekind (Ptr_Typ, E_General_Access_Type);
+ Mutate_Ekind (Ptr_Typ, E_General_Access_Type);
Set_Directly_Designated_Type (Ptr_Typ, Desig_Typ);
Ptr_Decl :=
-- Hook : Ptr_Typ := null;
Hook_Id := Make_Temporary (Loc, 'T');
- Set_Ekind (Hook_Id, E_Variable);
+ Mutate_Ekind (Hook_Id, E_Variable);
Set_Etype (Hook_Id, Ptr_Typ);
Hook_Decl :=
-- end Equiv_T;
Equiv_Type := Make_Temporary (Loc, 'T');
- Set_Ekind (Equiv_Type, E_Record_Type);
+ Mutate_Ekind (Equiv_Type, E_Record_Type);
Set_Parent_Subtype (Equiv_Type, Constr_Root);
-- Set Is_Class_Wide_Equivalent_Type very early to trigger the special
-- Define the dummy private subtype
- Set_Ekind (Priv_Subtyp, Subtype_Kind (Ekind (Unc_Typ)));
+ Mutate_Ekind (Priv_Subtyp, Subtype_Kind (Ekind (Unc_Typ)));
Set_Etype (Priv_Subtyp, Base_Type (Unc_Typ));
Set_Scope (Priv_Subtyp, Full_Subtyp);
Set_Is_Constrained (Priv_Subtyp);
Set_Associated_Node_For_Itype (Res, N);
Set_Comes_From_Source (Res, False);
- Set_Ekind (Res, E_Class_Wide_Subtype);
+ Mutate_Ekind (Res, E_Class_Wide_Subtype);
Set_Etype (Res, Base_Type (CW_Typ));
Set_Freeze_Node (Res, Empty);
Set_Is_Frozen (Res, False);
Put_Getter_Decl (S, Ekind);
Put (S, "function K (N : Entity_Id) return Entity_Kind renames Ekind;\n");
Put (S, "-- Shorthand for use in predicates and preconditions below\n");
- Put (S, "-- ????There is no procedure Set_Ekind here.\n");
- Put (S, "-- See Atree.\n\n");
+ Put (S, "-- There is no procedure Set_Ekind here.\n");
+ Put (S, "-- See Mutate_Ekind in Atree.\n\n");
when others => raise Program_Error;
end case;
-- (The matching Default_Value requirement is a simplification from the
-- earlier hand-written version.)
+ -- When adding new node or entity kinds, or adding new fields, all back
+ -- ends must be made aware of the changes. In addition, the documentation
+ -- in Sinfo or Einfo needs to be updated.
+
-- To add a new node or entity type, add it to the enumeration type in
-- Gen_IL.Types, taking care that it is in the approprate range
-- (Abstract_Node, Abstract_Entity, Concrete_Node, or Concrete_Entity).
-- Then add a call to one of the above type-creation procedures to
- -- Sinfo.Nodes or Einfo.Entities.
+ -- Gen_IL.Gen.Gen_Nodes or Gen_IL.Gen.Gen_Entities.
+ --
+ -- To add a new field to a type, add it to the enumeration type in
+ -- Gen_IL.Fields in the appropriate range. Then add a call to one of
+ -- the above field-creation procedures to Gen_IL.Gen.Gen_Nodes or
+ -- Gen_IL.Gen.Gen_Entities.
--
- -- To add a new field to a type, add a call to one of the above field
- -- creation procedures to Sinfo.Nodes or Einfo.Entities.
+ -- If a type or field name does not follow the usual Mixed_Case convention,
+ -- such as "SPARK_Pragma", then you have to add a special case to one of
+ -- the Image functions in Gen_IL.Utils.
-- Forward references are not allowed. So if you say:
--
end if;
Set_Body_To_Inline (Decl, Original_Body);
- Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
+ Mutate_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
Set_Is_Inlined (Spec_Id);
end Build_Body_To_Inline;
pragma Assert (No (Body_To_Inline (Decl)));
Set_Body_To_Inline (Decl, Original_Body);
- Set_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
+ Mutate_Ekind (Defining_Entity (Original_Body), Ekind (Spec_Id));
end Build_Body_To_Inline;
--------------------------------
Style_Check := False;
Initialize_Scanner (Units.Last, System_Source_File_Index);
Discard_List (Par (Configuration_Pragmas => False));
- Set_Ekind (Cunit_Entity (Units.Last), E_Package);
+ Mutate_Ekind (Cunit_Entity (Units.Last), E_Package);
Set_Scope (Cunit_Entity (Units.Last), Standard_Standard);
Style_Check := Save_Style;
Multiple_Unit_Index := Save_Mindex;
(Standard_Location,
Name_Enter (Name_Of_Heap_Variable));
- Set_Ekind (Heap, E_Variable);
+ Mutate_Ekind (Heap, E_Variable);
Set_Is_Internal (Heap, True);
Set_Etype (Heap, Standard_Void_Type);
Set_Scope (Heap, Standard_Standard);
Enter_Name (Id);
Set_Etype (Id, Index_Typ);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
Set_Scope (Id, Ent);
-- Analyze expression without expansion, to verify legality.
Set_Etype (Id, Key_Type);
end if;
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
Set_Scope (Id, Ent);
Set_Referenced (Id);
if No (Scope (Id)) then
Set_Etype (Id, Index_Type);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
Set_Scope (Id, Ent);
end if;
Enter_Name (Id);
-- when we load the proper body.
Set_Scope (Id, Current_Scope);
- Set_Ekind (Id, E_Package_Body);
+ Mutate_Ekind (Id, E_Package_Body);
Set_Etype (Id, Standard_Void_Type);
if Has_Aspects (N) then
Opts := Save_Config_Switches;
Set_Scope (Id, Current_Scope);
- Set_Ekind (Id, E_Protected_Body);
+ Mutate_Ekind (Id, E_Protected_Body);
Set_Etype (Id, Standard_Void_Type);
if Has_Aspects (N) then
else
Set_Scope (Id, Current_Scope);
- Set_Ekind (Id, E_Task_Body);
+ Mutate_Ekind (Id, E_Task_Body);
Set_Etype (Id, Standard_Void_Type);
if Has_Aspects (N) then
Set_Subtype_Indication (Decl,
New_Occurrence_Of (Non_Lim_View, Sloc (Def_Id)));
Set_Etype (Def_Id, Non_Lim_View);
- Set_Ekind (Def_Id, Subtype_Kind (Ekind (Non_Lim_View)));
+ Mutate_Ekind
+ (Def_Id, Subtype_Kind (Ekind (Non_Lim_View)));
Set_Analyzed (Decl, False);
-- Reanalyze the declaration, suppressing the call to
-- Minimum decoration
- Set_Ekind (P, E_Package);
+ Mutate_Ekind (P, E_Package);
Set_Etype (P, Standard_Void_Type);
Set_Scope (P, Standard_Standard);
Set_Is_Visible_Lib_Unit (P);
-- The abstract view of a variable is a state, not another variable
if Ekind (Ent) = E_Variable then
- Set_Ekind (Shadow, E_Abstract_State);
+ Mutate_Ekind (Shadow, E_Abstract_State);
else
- Set_Ekind (Shadow, Ekind (Ent));
+ Mutate_Ekind (Shadow, Ekind (Ent));
end if;
Set_Is_Internal (Shadow);
procedure Decorate_Package (Ent : Entity_Id; Scop : Entity_Id) is
begin
- Set_Ekind (Ent, E_Package);
+ Mutate_Ekind (Ent, E_Package);
Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Scop);
end Decorate_Package;
procedure Decorate_State (Ent : Entity_Id; Scop : Entity_Id) is
begin
- Set_Ekind (Ent, E_Abstract_State);
+ Mutate_Ekind (Ent, E_Abstract_State);
Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Scop);
Set_Encapsulating_State (Ent, Empty);
-- An unanalyzed type or a shadow entity of a type is treated as an
-- incomplete type, and carries the corresponding attributes.
- Set_Ekind (Ent, E_Incomplete_Type);
+ Mutate_Ekind (Ent, E_Incomplete_Type);
Set_Etype (Ent, Ent);
Set_Full_View (Ent, Empty);
Set_Is_First_Subtype (Ent);
Set_Parent (CW_Typ, Parent (Ent));
- Set_Ekind (CW_Typ, E_Class_Wide_Type);
+ Mutate_Ekind (CW_Typ, E_Class_Wide_Type);
Set_Class_Wide_Type (CW_Typ, CW_Typ);
Set_Etype (CW_Typ, Ent);
Set_Equivalent_Type (CW_Typ, Empty);
procedure Decorate_Variable (Ent : Entity_Id; Scop : Entity_Id) is
begin
- Set_Ekind (Ent, E_Variable);
+ Mutate_Ekind (Ent, E_Variable);
Set_Etype (Ent, Standard_Void_Type);
Set_Scope (Ent, Scop);
end Decorate_Variable;
-- must be minimally decorated. This ensures that the checks on unused
-- with clauses also process limieted withs.
- Set_Ekind (Pack, E_Package);
+ Mutate_Ekind (Pack, E_Package);
Set_Etype (Pack, Standard_Void_Type);
if Is_Entity_Name (Nam) then
-- incomplete view of all types and packages declared within.
Shadow_Pack := Make_Temporary (Sloc (N), 'Z');
- Set_Ekind (Shadow_Pack, E_Package);
+ Mutate_Ekind (Shadow_Pack, E_Package);
Set_Is_Internal (Shadow_Pack);
Set_Limited_View (Pack, Shadow_Pack);
begin
Generate_Definition (Id);
Enter_Name (Id);
- Set_Ekind (Id, E_Exception);
+ Mutate_Ekind (Id, E_Exception);
Set_Etype (Id, Standard_Exception_Type);
Set_Is_Statically_Allocated (Id);
Set_Is_Pure (Id, PF);
Set_Etype (H_Scope, Standard_Void_Type);
Enter_Name (Choice);
- Set_Ekind (Choice, E_Variable);
+ Mutate_Ekind (Choice, E_Variable);
if RTE_Available (RE_Exception_Occurrence) then
Set_Etype (Choice, RTE (RE_Exception_Occurrence));
Set_Is_Generic_Type (Base);
Set_Parent (Base, Parent (Def));
- Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
+ Mutate_Ekind (T, E_Decimal_Fixed_Point_Subtype);
Set_Etype (T, Base);
Set_Size_Info (T, Int_Base);
Set_RM_Size (T, RM_Size (Int_Base));
begin
Enter_Name (T);
- Set_Ekind (T, E_Enumeration_Subtype);
+ Mutate_Ekind (T, E_Enumeration_Subtype);
Set_Etype (T, Base);
Init_Size (T, 8);
Init_Alignment (T);
Low_Bound => Lo,
High_Bound => Hi));
- Set_Ekind (Base, E_Enumeration_Type);
+ Mutate_Ekind (Base, E_Enumeration_Type);
Set_Etype (Base, Base);
Init_Size (Base, 8);
Init_Alignment (Base);
-- the generic itself.
Enter_Name (T);
- Set_Ekind (T, E_Floating_Point_Subtype);
+ Mutate_Ekind (T, E_Floating_Point_Subtype);
Set_Etype (T, Base);
Set_Size_Info (T, (Standard_Float));
Set_RM_Size (T, RM_Size (Standard_Float));
-- signed integer types, and have the same attributes.
Analyze_Formal_Signed_Integer_Type (T, Def);
- Set_Ekind (T, E_Modular_Integer_Subtype);
- Set_Ekind (Etype (T), E_Modular_Integer_Type);
+ Mutate_Ekind (T, E_Modular_Integer_Subtype);
+ Mutate_Ekind (Etype (T), E_Modular_Integer_Type);
end Analyze_Formal_Modular_Type;
end if;
end if;
- Set_Ekind (Id, K);
+ Mutate_Ekind (Id, K);
Set_Etype (Id, T);
-- Case of generic IN OUT parameter
-- subtype, as is done for subprogram formals. In this fashion, all
-- its uses can refer to specific bounds.
- Set_Ekind (Id, K);
+ Mutate_Ekind (Id, K);
Set_Etype (Id, T);
if (Is_Array_Type (T) and then not Is_Constrained (T))
-- will never be used, since all properties of the type are non-static.
Enter_Name (T);
- Set_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
+ Mutate_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
Set_Etype (T, Base);
Set_Size_Info (T, Standard_Integer);
Set_RM_Size (T, RM_Size (Standard_Integer));
exception
when Instantiation_Error =>
Enter_Name (Formal);
- Set_Ekind (Formal, E_Variable);
- Set_Etype (Formal, Any_Type);
+ Mutate_Ekind (Formal, E_Variable);
+ Set_Etype (Formal, Any_Type);
Restore_Hidden_Primitives (Vis_Prims_List);
if Parent_Installed then
Set_Is_Generic_Instance (Formal);
Enter_Name (Formal);
- Set_Ekind (Formal, E_Package);
- Set_Etype (Formal, Standard_Void_Type);
+ Mutate_Ekind (Formal, E_Package);
+ Set_Etype (Formal, Standard_Void_Type);
Set_Inner_Instances (Formal, New_Elmt_List);
-- It is unclear that any aspects can apply to a formal package
Renaming_In_Par :=
Make_Defining_Identifier (Loc, Chars (Gen_Unit));
- Set_Ekind (Renaming_In_Par, E_Package);
+ Mutate_Ekind (Renaming_In_Par, E_Package);
Set_Etype (Renaming_In_Par, Standard_Void_Type);
Set_Scope (Renaming_In_Par, Parent_Instance);
Set_Parent (Renaming_In_Par, Parent (Formal));
-- Add semantic information to the original defining identifier.
- Set_Ekind (Pack_Id, E_Package);
+ Mutate_Ekind (Pack_Id, E_Package);
Set_Etype (Pack_Id, Standard_Void_Type);
Set_Scope (Pack_Id, Scope (Formal));
Set_Has_Completion (Pack_Id, True);
is
begin
Enter_Name (T);
- Set_Ekind (T, E_Incomplete_Type);
+ Mutate_Ekind (T, E_Incomplete_Type);
Set_Etype (T, T);
Set_Private_Dependents (T, New_Elmt_List);
begin
Enter_Name (T);
- Set_Ekind (T, E_Signed_Integer_Subtype);
+ Mutate_Ekind (T, E_Signed_Integer_Subtype);
Set_Etype (T, Base);
Set_Size_Info (T, Standard_Integer);
Set_RM_Size (T, RM_Size (Standard_Integer));
Start_Generic;
Enter_Name (Id);
- Set_Ekind (Id, E_Generic_Package);
- Set_Etype (Id, Standard_Void_Type);
+ Mutate_Ekind (Id, E_Generic_Package);
+ Set_Etype (Id, Standard_Void_Type);
-- Set SPARK_Mode from context
Analyze_Generic_Formal_Part (N);
if Nkind (Spec) = N_Function_Specification then
- Set_Ekind (Id, E_Generic_Function);
+ Mutate_Ekind (Id, E_Generic_Function);
else
- Set_Ekind (Id, E_Generic_Procedure);
+ Mutate_Ekind (Id, E_Generic_Procedure);
end if;
-- Set SPARK_Mode from context
end if;
Generate_Definition (Act_Decl_Id);
- Set_Ekind (Act_Decl_Id, E_Package);
+ Mutate_Ekind (Act_Decl_Id, E_Package);
-- Initialize list of incomplete actuals before analysis
goto Leave;
else
- Set_Ekind (Inst_Id, E_Package);
+ Mutate_Ekind (Inst_Id, E_Package);
Set_Scope (Inst_Id, Current_Scope);
-- If the context of the instance is subject to SPARK_Mode "off" or
Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
else
- Set_Ekind (Inst_Id, K);
+ Mutate_Ekind (Inst_Id, K);
Set_Scope (Inst_Id, Current_Scope);
Set_Entity (Gen_Id, Gen_Unit);
Func_Name := New_Occurrence_Of (Actual_Subp, Loc);
Func := Make_Defining_Identifier (Loc, Chars (Formal_Subp));
- Set_Ekind (Func, E_Function);
+ Mutate_Ekind (Func, E_Function);
Set_Is_Generic_Actual_Subprogram (Func);
Actuals := New_List;
R := New_Occurrence_Of (F2, Loc);
Func := Make_Defining_Identifier (Loc, Chars (Formal_Subp));
- Set_Ekind (Func, E_Function);
+ Mutate_Ekind (Func, E_Function);
Set_Is_Generic_Actual_Subprogram (Func);
Spec :=
begin
Subp := Make_Defining_Identifier (Loc, Chars (Formal_Subp));
- Set_Ekind (Subp, Ekind (Formal_Subp));
+ Mutate_Ekind (Subp, Ekind (Formal_Subp));
Set_Is_Generic_Actual_Subprogram (Subp);
Profile := Parameter_Specifications (
begin
Set_Is_Internal (I_Pack);
- Set_Ekind (I_Pack, E_Package);
+ Mutate_Ekind (I_Pack, E_Package);
Set_Hidden_In_Formal_Instance (I_Pack, Hidden_Formals);
Append_To (Decls,
New_Subp := Make_Defining_Identifier (Loc, Chars (Formal_Sub));
end if;
- Set_Ekind (New_Subp, Ekind (Analyzed_S));
+ Mutate_Ekind (New_Subp, Ekind (Analyzed_S));
Set_Is_Generic_Actual_Subprogram (New_Subp);
Set_Defining_Unit_Name (New_Spec, New_Subp);
-- the local subtype must be treated as such.
if From_Limited_With (Act_T) then
- Set_Ekind (Subt, E_Incomplete_Subtype);
+ Mutate_Ekind (Subt, E_Incomplete_Subtype);
Set_From_Limited_With (Subt);
end if;
Append_To (Decl_Nodes, Corr_Decl);
if Ekind (Act_T) = E_Task_Type then
- Set_Ekind (Subt, E_Task_Subtype);
+ Mutate_Ekind (Subt, E_Task_Subtype);
else
- Set_Ekind (Subt, E_Protected_Subtype);
+ Mutate_Ekind (Subt, E_Protected_Subtype);
end if;
Set_Corresponding_Record_Type (Subt, Corr_Rec);
FBody : Node_Id;
begin
- Set_Ekind (SIdB, E_Function);
+ Mutate_Ekind (SIdB, E_Function);
Set_Is_Predicate_Function (SIdB);
-- Build function body
-- Build function declaration
- Set_Ekind (SId, E_Function);
+ Mutate_Ekind (SId, E_Function);
Set_Is_Predicate_Function_M (SId);
Set_Predicate_Function_M (Typ, SId);
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (Typ), "Predicate"));
- Set_Ekind (Func_Id, E_Function);
+ Mutate_Ekind (Func_Id, E_Function);
Set_Etype (Func_Id, Standard_Boolean);
Set_Is_Internal (Func_Id);
Set_Is_Predicate_Function (Func_Id);
T_Def => Access_To_Subprogram_Definition (N));
if Ekind (Anon_Type) = E_Access_Protected_Subprogram_Type then
- Set_Ekind
+ Mutate_Ekind
(Anon_Type, E_Anonymous_Access_Protected_Subprogram_Type);
else
- Set_Ekind (Anon_Type, E_Anonymous_Access_Subprogram_Type);
+ Mutate_Ekind (Anon_Type, E_Anonymous_Access_Subprogram_Type);
end if;
Set_Can_Use_Internal_Rep
Check_Delayed_Subprogram (Desig_Type);
if Protected_Present (T_Def) then
- Set_Ekind (T_Name, E_Access_Protected_Subprogram_Type);
+ Mutate_Ekind (T_Name, E_Access_Protected_Subprogram_Type);
Set_Convention (Desig_Type, Convention_Protected);
else
- Set_Ekind (T_Name, E_Access_Subprogram_Type);
+ Mutate_Ekind (T_Name, E_Access_Subprogram_Type);
end if;
Set_Can_Use_Internal_Rep (T_Name,
if From_Limited_With (Entity (S))
and then not Is_Class_Wide_Type (Entity (S))
then
- Set_Ekind (T, E_Access_Type);
+ Mutate_Ekind (T, E_Access_Type);
Build_Master_Entity (T);
Build_Master_Renaming (T);
end if;
end if;
if All_Present (Def) or Constant_Present (Def) then
- Set_Ekind (T, E_General_Access_Type);
+ Mutate_Ekind (T, E_General_Access_Type);
else
- Set_Ekind (T, E_Access_Type);
+ Mutate_Ekind (T, E_Access_Type);
end if;
if not Error_Posted (T) then
Analyze_Component_Declaration (Decl);
Set_Analyzed (Decl);
- Set_Ekind (Tag, E_Component);
+ Mutate_Ekind (Tag, E_Component);
Set_Is_Tag (Tag);
Set_Is_Aliased (Tag);
Set_Is_Independent (Tag);
Analyze_Component_Declaration (Decl);
Set_Analyzed (Decl);
- Set_Ekind (Offset, E_Component);
+ Mutate_Ekind (Offset, E_Component);
Set_Is_Aliased (Offset);
Set_Is_Independent (Offset);
Set_Related_Type (Offset, Iface);
T := Find_Type_Name (N);
- Set_Ekind (T, E_Incomplete_Type);
+ Mutate_Ekind (T, E_Incomplete_Type);
Set_Etype (T, T);
Set_Is_First_Subtype (T);
Init_Size_Align (T);
Set_Etype (E, Universal_Integer);
Set_Etype (Id, Universal_Integer);
- Set_Ekind (Id, E_Named_Integer);
+ Mutate_Ekind (Id, E_Named_Integer);
Set_Is_Frozen (Id, True);
Set_Debug_Info_Needed (Id);
if Is_Integer_Type (T) then
Resolve (E, T);
Set_Etype (Id, Universal_Integer);
- Set_Ekind (Id, E_Named_Integer);
+ Mutate_Ekind (Id, E_Named_Integer);
elsif Is_Real_Type (T) then
Resolve (E, T);
Set_Etype (Id, Universal_Real);
- Set_Ekind (Id, E_Named_Real);
+ Mutate_Ekind (Id, E_Named_Real);
else
Wrong_Type (E, Any_Numeric);
Resolve (E, T);
Set_Etype (Id, T);
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
Set_Never_Set_In_Source (Id, True);
Set_Is_True_Constant (Id, True);
return;
T := Find_Type_Of_Object (Object_Definition (N), N);
Set_Etype (Id, T);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
goto Leave;
end if;
if Error_Posted (Id) then
Set_Etype (Id, T);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
goto Leave;
end if;
end if;
and then In_Subrange_Of (Etype (Entity (E)), T)
then
Set_Is_Known_Valid (Id);
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
Set_Actual_Subtype (Id, Etype (Entity (E)));
end if;
elsif Is_Unchecked_Union (T) then
if Constant_Present (N) or else Nkind (E) = N_Function_Call then
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
else
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
end if;
-- If the expression is an aggregate it contains the required
end if;
if Constant_Present (N) then
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
Set_Is_True_Constant (Id);
else
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
-- A variable is set as shared passive if it appears in a shared
-- passive package, and is at the outer level. This is not done for
Parent_Base := Base_Type (Parent_Type);
if Parent_Type = Any_Type or else Etype (Parent_Type) = Any_Type then
- Set_Ekind (T, Ekind (Parent_Type));
+ Mutate_Ekind (T, Ekind (Parent_Type));
Set_Etype (T, Any_Type);
goto Leave;
& "tagged type (RM 3.9.1 (3/1))", N);
Set_Etype (T, Any_Type);
- Set_Ekind (T, E_Limited_Private_Type);
+ Mutate_Ekind (T, E_Limited_Private_Type);
Set_Private_Dependents (T, New_Elmt_List);
Set_Error_Posted (T);
goto Leave;
Set_Is_Pure (T, Is_Pure (Current_Scope));
Set_Scope (T, Current_Scope);
- Set_Ekind (T, E_Record_Type_With_Private);
+ Mutate_Ekind (T, E_Record_Type_With_Private);
Init_Size_Align (T);
Set_Default_SSO (T);
Set_No_Reordering (T, No_Component_Reordering);
-- (no aspects to examine on the generated declaration).
if not Comes_From_Source (N) then
- Set_Ekind (Id, Ekind (T));
+ Mutate_Ekind (Id, Ekind (T));
if Present (Predicate_Function (Id)) then
null;
case Ekind (T) is
when Array_Kind =>
- Set_Ekind (Id, E_Array_Subtype);
+ Mutate_Ekind (Id, E_Array_Subtype);
Copy_Array_Subtype_Attributes (Id, T);
when Decimal_Fixed_Point_Kind =>
- Set_Ekind (Id, E_Decimal_Fixed_Point_Subtype);
+ Mutate_Ekind (Id, E_Decimal_Fixed_Point_Subtype);
Set_Digits_Value (Id, Digits_Value (T));
Set_Delta_Value (Id, Delta_Value (T));
Set_Scale_Value (Id, Scale_Value (T));
Set_RM_Size (Id, RM_Size (T));
when Enumeration_Kind =>
- Set_Ekind (Id, E_Enumeration_Subtype);
+ Mutate_Ekind (Id, E_Enumeration_Subtype);
Set_First_Literal (Id, First_Literal (Base_Type (T)));
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Character_Type (Id, Is_Character_Type (T));
Set_RM_Size (Id, RM_Size (T));
when Ordinary_Fixed_Point_Kind =>
- Set_Ekind (Id, E_Ordinary_Fixed_Point_Subtype);
+ Mutate_Ekind (Id, E_Ordinary_Fixed_Point_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Small_Value (Id, Small_Value (T));
Set_Delta_Value (Id, Delta_Value (T));
Set_RM_Size (Id, RM_Size (T));
when Float_Kind =>
- Set_Ekind (Id, E_Floating_Point_Subtype);
+ Mutate_Ekind (Id, E_Floating_Point_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Digits_Value (Id, Digits_Value (T));
Set_Is_Constrained (Id, Is_Constrained (T));
-- inherited subsequently when Analyze_Dimensions is called.
when Signed_Integer_Kind =>
- Set_Ekind (Id, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Id, E_Signed_Integer_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T));
when Modular_Integer_Kind =>
- Set_Ekind (Id, E_Modular_Integer_Subtype);
+ Mutate_Ekind (Id, E_Modular_Integer_Subtype);
Set_Scalar_Range (Id, Scalar_Range (T));
Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Known_Valid (Id, Is_Known_Valid (T));
Set_RM_Size (Id, RM_Size (T));
when Class_Wide_Kind =>
- Set_Ekind (Id, E_Class_Wide_Subtype);
+ Mutate_Ekind (Id, E_Class_Wide_Subtype);
Set_Class_Wide_Type (Id, Class_Wide_Type (T));
Set_Cloned_Subtype (Id, T);
Set_Is_Tagged_Type (Id, True);
when E_Record_Subtype
| E_Record_Type
=>
- Set_Ekind (Id, E_Record_Subtype);
+ Mutate_Ekind (Id, E_Record_Subtype);
-- Subtype declarations introduced for formal type parameters
-- in generic instantiations should inherit the Size value of
end if;
when Private_Kind =>
- Set_Ekind (Id, Subtype_Kind (Ekind (T)));
+ Mutate_Ekind (Id, Subtype_Kind (Ekind (T)));
Set_Has_Discriminants (Id, Has_Discriminants (T));
Set_Is_Constrained (Id, Is_Constrained (T));
Set_First_Entity (Id, First_Entity (T));
end if;
when Access_Kind =>
- Set_Ekind (Id, E_Access_Subtype);
+ Mutate_Ekind (Id, E_Access_Subtype);
Set_Is_Constrained (Id, Is_Constrained (T));
Set_Is_Access_Constant
(Id, Is_Access_Constant (T));
end if;
when Concurrent_Kind =>
- Set_Ekind (Id, Subtype_Kind (Ekind (T)));
+ Mutate_Ekind (Id, Subtype_Kind (Ekind (T)));
Set_Corresponding_Record_Type (Id,
Corresponding_Record_Type (T));
Set_First_Entity (Id, First_Entity (T));
-- propagate indication. Note that we also have to include
-- subtypes for Ada 2012 extended use of incomplete types.
- Set_Ekind (Id, E_Incomplete_Subtype);
+ Mutate_Ekind (Id, E_Incomplete_Subtype);
Set_Is_Tagged_Type (Id, Is_Tagged_Type (T));
Set_Private_Dependents (Id, New_Elmt_List);
-- The constrained array type is a subtype of the unconstrained one
- Set_Ekind (T, E_Array_Subtype);
+ Mutate_Ekind (T, E_Array_Subtype);
Init_Size_Align (T);
Set_Etype (T, Implicit_Base);
Set_Scope (T, Current_Scope);
pragma Assert (Ekind (T) = E_Void);
end if;
- Set_Ekind (T, E_Array_Type);
+ Mutate_Ekind (T, E_Array_Type);
Init_Size_Align (T);
Set_Etype (T, T);
Set_Scope (T, Current_Scope);
Scope_Stack.Append (Curr_Scope);
end if;
- Set_Ekind (Anon, E_Anonymous_Access_Protected_Subprogram_Type);
+ Mutate_Ekind (Anon, E_Anonymous_Access_Protected_Subprogram_Type);
Set_Can_Use_Internal_Rep (Anon, not Always_Compatible_Rep_On_Target);
return Anon;
end Replace_Anonymous_Access_To_Protected_Subprogram;
if Nkind (S) /= N_Subtype_Indication
and then Subt /= Base_Type (Subt)
then
- Set_Ekind (Derived_Type, E_Access_Subtype);
+ Mutate_Ekind (Derived_Type, E_Access_Subtype);
end if;
if Ekind (Derived_Type) = E_Access_Subtype then
Implicit_Base :=
Create_Itype (Ekind (Parent_Base), N, Derived_Type, 'B');
- Set_Ekind (Implicit_Base, Ekind (Parent_Base));
+ Mutate_Ekind (Implicit_Base, Ekind (Parent_Base));
Set_Etype (Implicit_Base, Parent_Base);
Copy_Array_Subtype_Attributes (Implicit_Base, Parent_Base);
begin
if not Is_Constrained (Parent_Type) then
if Nkind (Indic) /= N_Subtype_Indication then
- Set_Ekind (Derived_Type, E_Array_Type);
+ Mutate_Ekind (Derived_Type, E_Array_Type);
Copy_Array_Subtype_Attributes (Derived_Type, Parent_Type);
Copy_Array_Base_Type_Attributes (Derived_Type, Parent_Type);
if Nkind (Indic) /= N_Subtype_Indication then
Make_Implicit_Base;
- Set_Ekind (Derived_Type, Ekind (Parent_Type));
+ Mutate_Ekind (Derived_Type, Ekind (Parent_Type));
Set_Etype (Derived_Type, Implicit_Base);
Copy_Array_Subtype_Attributes (Derived_Type, Parent_Type);
New_Lit := Make_Defining_Identifier (Loc, Chars (Literal));
end if;
- Set_Ekind (New_Lit, E_Enumeration_Literal);
+ Mutate_Ekind (New_Lit, E_Enumeration_Literal);
Set_Enumeration_Pos (New_Lit, Enumeration_Pos (Literal));
Set_Enumeration_Rep (New_Lit, Enumeration_Rep (Literal));
Set_Enumeration_Rep_Expr (New_Lit, Empty);
-- may be hidden by a previous explicit function definition (cf.
-- c83031a).
- Set_Ekind (Derived_Type, E_Enumeration_Subtype);
+ Mutate_Ekind (Derived_Type, E_Enumeration_Subtype);
Set_Etype (Derived_Type, Implicit_Base);
Type_Decl :=
Create_Itype (Ekind (Parent_Base), N, Derived_Type, 'B');
Set_Etype (Implicit_Base, Parent_Base);
- Set_Ekind (Implicit_Base, Ekind (Parent_Base));
+ Mutate_Ekind (Implicit_Base, Ekind (Parent_Base));
Set_Size_Info (Implicit_Base, Parent_Base);
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base));
Set_Parent (Implicit_Base, Parent (Derived_Type));
-- parent type (otherwise Process_Subtype has set the bounds)
if No_Constraint then
- Set_Ekind (Derived_Type, Subtype_Kind (Ekind (Parent_Type)));
+ Mutate_Ekind (Derived_Type, Subtype_Kind (Ekind (Parent_Type)));
end if;
-- If we did not have a range constraint, then set the range from the
-- prevent spurious errors associated with missing overriding
-- of abstract primitives (overridden only for Derived_Type).
- Set_Ekind (Full_Der, E_Record_Type);
+ Mutate_Ekind (Full_Der, E_Record_Type);
Set_Is_Underlying_Record_View (Full_Der);
Set_Default_SSO (Full_Der);
Set_No_Reordering (Full_Der, No_Component_Reordering);
if Private_Extension then
Type_Def := N;
- Set_Ekind (Derived_Type, E_Record_Type_With_Private);
+ Mutate_Ekind (Derived_Type, E_Record_Type_With_Private);
Set_Default_SSO (Derived_Type);
Set_No_Reordering (Derived_Type, No_Component_Reordering);
-- For untagged types we preserve the Ekind of the Parent_Base.
if Present (Record_Extension_Part (Type_Def)) then
- Set_Ekind (Derived_Type, E_Record_Type);
+ Mutate_Ekind (Derived_Type, E_Record_Type);
Set_Default_SSO (Derived_Type);
Set_No_Reordering (Derived_Type, No_Component_Reordering);
end if;
else
- Set_Ekind (Derived_Type, Ekind (Parent_Base));
+ Mutate_Ekind (Derived_Type, Ekind (Parent_Base));
end if;
end if;
Set_Scope (Derived_Type, Current_Scope);
Set_Etype (Derived_Type, Parent_Base);
- Set_Ekind (Derived_Type, Ekind (Parent_Base));
+ Mutate_Ekind (Derived_Type, Ekind (Parent_Base));
Propagate_Concurrent_Flags (Derived_Type, Parent_Base);
Set_Size_Info (Derived_Type, Parent_Type);
D_Minal := Make_Defining_Identifier (Sloc (Discrim), Chars (Discrim));
- Set_Ekind (D_Minal, E_In_Parameter);
+ Mutate_Ekind (D_Minal, E_In_Parameter);
Set_Mechanism (D_Minal, Default_Mechanism);
Set_Etype (D_Minal, Etype (Discrim));
Set_Scope (D_Minal, Current_Scope);
then
CR_Disc := Make_Defining_Identifier (Sloc (Discrim), Chars (Discrim));
- Set_Ekind (CR_Disc, E_In_Parameter);
+ Mutate_Ekind (CR_Disc, E_In_Parameter);
Set_Mechanism (CR_Disc, Default_Mechanism);
Set_Etype (CR_Disc, Etype (Discrim));
Set_Scope (CR_Disc, Current_Scope);
begin
if Ekind (T) = E_Record_Type then
- Set_Ekind (Def_Id, E_Record_Subtype);
+ Mutate_Ekind (Def_Id, E_Record_Subtype);
-- Inherit preelaboration flag from base, for types for which it
-- may have been set: records, private types, protected types.
(Def_Id, Known_To_Have_Preelab_Init (T));
elsif Ekind (T) = E_Task_Type then
- Set_Ekind (Def_Id, E_Task_Subtype);
+ Mutate_Ekind (Def_Id, E_Task_Subtype);
elsif Ekind (T) = E_Protected_Type then
- Set_Ekind (Def_Id, E_Protected_Subtype);
+ Mutate_Ekind (Def_Id, E_Protected_Subtype);
Set_Known_To_Have_Preelab_Init
(Def_Id, Known_To_Have_Preelab_Init (T));
elsif Is_Private_Type (T) then
- Set_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
+ Mutate_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
Set_Known_To_Have_Preelab_Init
(Def_Id, Known_To_Have_Preelab_Init (T));
Set_Private_Dependents (Def_Id, New_Elmt_List);
elsif Is_Class_Wide_Type (T) then
- Set_Ekind (Def_Id, E_Class_Wide_Subtype);
+ Mutate_Ekind (Def_Id, E_Class_Wide_Subtype);
else
-- Incomplete type. Attach subtype to list of dependents, to be
-- initialization procedure.
if Ekind (T) = E_Incomplete_Type then
- Set_Ekind (Def_Id, E_Incomplete_Subtype);
+ Mutate_Ekind (Def_Id, E_Incomplete_Subtype);
else
- Set_Ekind (Def_Id, Ekind (T));
+ Mutate_Ekind (Def_Id, Ekind (T));
end if;
if For_Access and then Within_Init_Proc then
end if;
if Ekind (Designated_Type (Anon_Access)) = E_Subprogram_Type then
- Set_Ekind (Anon_Access, E_Anonymous_Access_Subprogram_Type);
+ Mutate_Ekind (Anon_Access, E_Anonymous_Access_Subprogram_Type);
else
- Set_Ekind (Anon_Access, E_Anonymous_Access_Type);
+ Mutate_Ekind (Anon_Access, E_Anonymous_Access_Type);
end if;
Set_Is_Local_Anonymous_Access (Anon_Access);
-- Set common attributes for all subtypes: kind, convention, etc.
- Set_Ekind (Full, Subtype_Kind (Ekind (Full_Base)));
+ Mutate_Ekind (Full, Subtype_Kind (Ekind (Full_Base)));
Set_Convention (Full, Convention (Full_Base));
Set_Is_First_Subtype (Full, False);
Set_Scope (Full, Scope (Priv));
Desig_Subtype :=
Create_Itype
(E_Void, Related_Nod, Scope_Id => Scope (Desig_Type));
- Set_Ekind (Desig_Subtype, E_Record_Subtype);
+ Mutate_Ekind (Desig_Subtype, E_Record_Subtype);
Def_Id := Entity (Subtype_Mark (S));
-- We indicate that the component has a per-object constraint
if No (Def_Id) then
Def_Id := Create_Itype (E_Access_Subtype, Related_Nod);
else
- Set_Ekind (Def_Id, E_Access_Subtype);
+ Mutate_Ekind (Def_Id, E_Access_Subtype);
end if;
if Constraint_OK then
Set_Parent (Def_Id, Related_Nod);
else
- Set_Ekind (Def_Id, E_Array_Subtype);
+ Mutate_Ekind (Def_Id, E_Array_Subtype);
end if;
Set_Size_Info (Def_Id, (T));
Bound_Val : Ureal;
begin
- Set_Ekind (Def_Id, E_Decimal_Fixed_Point_Subtype);
+ Mutate_Ekind (Def_Id, E_Decimal_Fixed_Point_Subtype);
if Nkind (C) = N_Range_Constraint then
Range_Expr := Range_Expression (C);
begin
-- Set a reasonable Ekind for the entity, including incomplete types.
- Set_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
+ Mutate_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
-- Set Etype to the known type, to reduce chances of cascaded errors
C : constant Node_Id := Constraint (S);
begin
- Set_Ekind (Def_Id, E_Enumeration_Subtype);
+ Mutate_Ekind (Def_Id, E_Enumeration_Subtype);
Set_First_Literal (Def_Id, First_Literal (Base_Type (T)));
Rais : Node_Id;
begin
- Set_Ekind (Def_Id, E_Floating_Point_Subtype);
+ Mutate_Ekind (Def_Id, E_Floating_Point_Subtype);
Set_Etype (Def_Id, Base_Type (T));
Set_Size_Info (Def_Id, (T));
-- Complete construction of the Itype
if Is_Modular_Integer_Type (T) then
- Set_Ekind (Def_Id, E_Modular_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Modular_Integer_Subtype);
elsif Is_Integer_Type (T) then
- Set_Ekind (Def_Id, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Signed_Integer_Subtype);
else
- Set_Ekind (Def_Id, E_Enumeration_Subtype);
+ Mutate_Ekind (Def_Id, E_Enumeration_Subtype);
Set_Is_Character_Type (Def_Id, Is_Character_Type (T));
Set_First_Literal (Def_Id, First_Literal (T));
end if;
Set_Scalar_Range_For_Subtype (Def_Id, Range_Expression (C), T);
if Is_Modular_Integer_Type (T) then
- Set_Ekind (Def_Id, E_Modular_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Modular_Integer_Subtype);
else
- Set_Ekind (Def_Id, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Signed_Integer_Subtype);
end if;
Set_Etype (Def_Id, Base_Type (T));
Rais : Node_Id;
begin
- Set_Ekind (Def_Id, E_Ordinary_Fixed_Point_Subtype);
+ Mutate_Ekind (Def_Id, E_Ordinary_Fixed_Point_Subtype);
Set_Etype (Def_Id, Base_Type (T));
Set_Size_Info (Def_Id, (T));
Set_First_Rep_Item (Def_Id, First_Rep_Item (T));
-- appropriate choice, since it allowed the attributes to be set
-- in the first place. This Ekind value will be modified later.
- Set_Ekind (Full, Ekind (Priv));
+ Mutate_Ekind (Full, Ekind (Priv));
-- Also set Etype temporarily to Any_Type, again, in the absence
-- of errors, it will be properly reset, and if there are errors,
-- chain ensures that SPARK-related pragmas are not clobbered when the
-- decimal fixed point type acts as a full view of a private type.
- Set_Ekind (T, E_Decimal_Fixed_Point_Subtype);
+ Mutate_Ekind (T, E_Decimal_Fixed_Point_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Inherit_Rep_Item_Chain (T, Implicit_Base);
begin
New_Subp := New_Entity (Nkind (Parent_Subp), Sloc (Derived_Type));
- Set_Ekind (New_Subp, Ekind (Parent_Subp));
+ Mutate_Ekind (New_Subp, Ekind (Parent_Subp));
-- Check whether the inherited subprogram is a private operation that
-- should be inherited but not yet made visible. Such subprograms can
Conditional_Delay (Derived_Type, Parent_Type);
- Set_Ekind (Derived_Type, E_Enumeration_Subtype);
+ Mutate_Ekind (Derived_Type, E_Enumeration_Subtype);
Set_Etype (Derived_Type, Implicit_Base);
Set_Size_Info (Derived_Type, Parent_Type);
Error_Msg_N ("type cannot be used in its own definition", Indic);
end if;
- Set_Ekind (T, Ekind (Parent_Type));
+ Mutate_Ekind (T, Ekind (Parent_Type));
Set_Etype (T, Any_Type);
Set_Scalar_Range (T, Scalar_Range (Any_Type));
R_Node := New_Node (N_Range, Sloc (Def));
Set_Low_Bound (R_Node, B_Node);
- Set_Ekind (T, E_Enumeration_Type);
+ Mutate_Ekind (T, E_Enumeration_Type);
Set_First_Literal (T, L);
Set_Etype (T, T);
Set_Is_Constrained (T);
while Present (L) loop
if Ekind (L) /= E_Enumeration_Literal then
- Set_Ekind (L, E_Enumeration_Literal);
+ Mutate_Ekind (L, E_Enumeration_Literal);
Set_Enumeration_Pos (L, Ev);
Set_Enumeration_Rep (L, Ev);
Set_Is_Known_Valid (L, True);
if Is_Tagged_Type (Prev)
and then Present (Class_Wide_Type (Prev))
then
- Set_Ekind (Id, Ekind (Prev)); -- will be reset later
+ Mutate_Ekind (Id, Ekind (Prev)); -- will be reset later
Set_Class_Wide_Type (Id, Class_Wide_Type (Prev));
-- Type of the class-wide type is the current Id. Previously
Subtype_Indication => Relocate_Node (Obj_Def));
begin
Set_Etype (T, Base_T);
- Set_Ekind (T, Subtype_Kind (Ekind (Base_T)));
+ Mutate_Ekind (T, Subtype_Kind (Ekind (Base_T)));
Set_Parent (T, Obj_Def);
if Ekind (T) = E_Array_Subtype then
Set_Digits_Value (Implicit_Base, Digits_Value (Base_Typ));
Set_Float_Rep (Implicit_Base, Float_Rep (Base_Typ));
- Set_Ekind (T, E_Floating_Point_Subtype);
+ Mutate_Ekind (T, E_Floating_Point_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Set_RM_Size (T, RM_Size (Implicit_Base));
if Is_Tagged and then Ekind (New_C) = E_Component
and then Nkind (N) /= N_Private_Extension_Declaration
then
- Set_Ekind (New_C, E_Void);
+ Mutate_Ekind (New_C, E_Void);
end if;
if Plain_Discrim then
Reinit_Field_To_Zero (CW_Type, SPARK_Aux_Pragma_Inherited);
end if;
- Set_Ekind (CW_Type, E_Class_Wide_Type);
+ Mutate_Ekind (CW_Type, E_Class_Wide_Type);
Set_Is_Tagged_Type (CW_Type, True);
Set_Direct_Primitive_Operations (CW_Type, New_Elmt_List);
Set_Is_Abstract_Type (CW_Type, False);
Set_Etype (Def_Id, Base_Type (T));
if Is_Signed_Integer_Type (T) then
- Set_Ekind (Def_Id, E_Signed_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Signed_Integer_Subtype);
elsif Is_Modular_Integer_Type (T) then
- Set_Ekind (Def_Id, E_Modular_Integer_Subtype);
+ Mutate_Ekind (Def_Id, E_Modular_Integer_Subtype);
else
- Set_Ekind (Def_Id, E_Enumeration_Subtype);
+ Mutate_Ekind (Def_Id, E_Enumeration_Subtype);
Set_Is_Character_Type (Def_Id, Is_Character_Type (T));
Set_First_Literal (Def_Id, First_Literal (T));
end if;
Analyze_And_Resolve (Mod_Expr, Any_Integer);
Set_Etype (T, T);
- Set_Ekind (T, E_Modular_Integer_Type);
+ Mutate_Ekind (T, E_Modular_Integer_Type);
Init_Alignment (T);
Set_Is_Constrained (T);
begin
Op := Make_Defining_Operator_Symbol (Loc, Name_Op_Concat);
- Set_Ekind (Op, E_Operator);
+ Mutate_Ekind (Op, E_Operator);
Set_Scope (Op, Current_Scope);
Set_Etype (Op, Typ);
Set_Homonym (Op, Get_Name_Entity_Id (Name_Op_Concat));
-- chain ensures that SPARK-related pragmas are not clobbered when the
-- ordinary fixed point type acts as a full view of a private type.
- Set_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
+ Mutate_Ekind (T, E_Ordinary_Fixed_Point_Subtype);
Set_Etype (T, Implicit_Base);
Init_Size_Align (T);
Inherit_Rep_Item_Chain (T, Implicit_Base);
Reinit_Field_To_Zero (Id, Discriminal_Link);
end if;
- Set_Ekind (Id, E_Discriminant);
+ Mutate_Ekind (Id, E_Discriminant);
Init_Component_Location (Id);
Init_Esize (Id);
Set_Discriminant_Number (Id, Discr_Number);
Reinit_Field_To_Zero
(Priv_Dep, Private_Dependents,
Old_Ekind => E_Incomplete_Subtype);
- Set_Ekind (Priv_Dep, Subtype_Kind (Ekind (Full_T)));
+ Mutate_Ekind (Priv_Dep, Subtype_Kind (Ekind (Full_T)));
Set_Etype (Priv_Dep, Full_T);
Set_Analyzed (Parent (Priv_Dep), False);
-- Set Ekind of orphan itype, to prevent cascaded errors
if Present (Def_Id) then
- Set_Ekind (Def_Id, Ekind (Any_Type));
+ Mutate_Ekind (Def_Id, Ekind (Any_Type));
end if;
-- Make recursive call, having got rid of the bogus constraint
-- These flags must be initialized before calling Process_Discriminants
-- because this routine makes use of them.
- Set_Ekind (T, E_Record_Type);
+ Mutate_Ekind (T, E_Record_Type);
Set_Etype (T, T);
Init_Size_Align (T);
Set_Interfaces (T, No_Elist);
Tag_Comp := Make_Defining_Identifier (Sloc (Def), Name_uTag);
Enter_Name (Tag_Comp);
- Set_Ekind (Tag_Comp, E_Component);
+ Mutate_Ekind (Tag_Comp, E_Component);
Set_Is_Tag (Tag_Comp);
Set_Is_Aliased (Tag_Comp);
Set_Is_Independent (Tag_Comp);
if Ekind (Component) = E_Void
and then not Is_Itype (Component)
then
- Set_Ekind (Component, E_Component);
+ Mutate_Ekind (Component, E_Component);
Init_Component_Location (Component);
end if;
-- Reset the kind of the subtype during analysis of the range, to
-- catch possible premature use in the bounds themselves.
- Set_Ekind (Def_Id, E_Void);
+ Mutate_Ekind (Def_Id, E_Void);
Process_Range_Expr_In_Decl (R, Subt, Subtyp => Def_Id);
- Set_Ekind (Def_Id, Kind);
+ Mutate_Ekind (Def_Id, Kind);
end Set_Scalar_Range_For_Subtype;
--------------------------------------------------------
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Base_Typ));
Set_Scalar_Range (Implicit_Base, Scalar_Range (Base_Typ));
- Set_Ekind (T, E_Signed_Integer_Subtype);
+ Mutate_Ekind (T, E_Signed_Integer_Subtype);
Set_Etype (T, Implicit_Base);
Set_Size_Info (T, Implicit_Base);
Inherit_Rep_Item_Chain (T, Implicit_Base);
Reinit_Field_To_Zero (Ent, Enclosing_Scope);
end if;
- Set_Ekind (Ent, E_Block);
+ Mutate_Ekind (Ent, E_Block);
Generate_Reference (Ent, N, ' ');
Generate_Definition (Ent);
Id : constant Node_Id := Defining_Identifier (N);
begin
Enter_Name (Id);
- Set_Ekind (Id, E_Label);
+ Mutate_Ekind (Id, E_Label);
Set_Etype (Id, Standard_Void_Type);
Set_Enclosing_Scope (Id, Current_Scope);
end Analyze_Implicit_Label_Declaration;
-- Set the kind of the loop variable, which is not visible within the
-- iterator name.
- Set_Ekind (Def_Id, E_Variable);
+ Mutate_Ekind (Def_Id, E_Variable);
-- Provide a link between the iterator variable and the container, for
-- subsequent use in cross-reference and modification information.
-- Prevent cascaded errors
- Set_Ekind (Def_Id, E_Loop_Parameter);
+ Mutate_Ekind (Def_Id, E_Loop_Parameter);
Set_Etype (Def_Id, Etype (First_Index (Typ)));
end if;
-- Iteration over a container
else
- Set_Ekind (Def_Id, E_Loop_Parameter);
+ Mutate_Ekind (Def_Id, E_Loop_Parameter);
Error_Msg_Ada_2012_Feature ("container iterator", Sloc (N));
-- OF present
-- element is a variable and is modifiable in the loop.
if Has_Aspect (Typ, Aspect_Variable_Indexing) then
- Set_Ekind (Def_Id, E_Variable);
+ Mutate_Ekind (Def_Id, E_Variable);
end if;
-- If the container is a constant, iterating over it
procedure Analyze_Label_Entity (E : Entity_Id) is
begin
- Set_Ekind (E, E_Label);
+ Mutate_Ekind (E, E_Label);
Set_Etype (E, Standard_Void_Type);
Set_Enclosing_Scope (E, Current_Scope);
Set_Reachable (E, True);
-- subsequent analysis of the condition in a quantified
-- expression.
- Set_Ekind (Id, E_Loop_Parameter);
+ Mutate_Ekind (Id, E_Loop_Parameter);
return;
end;
Make_Index (DS, N);
end if;
- Set_Ekind (Id, E_Loop_Parameter);
+ Mutate_Ekind (Id, E_Loop_Parameter);
-- A quantified expression which appears in a pre- or post-condition may
-- be analyzed multiple times. The analysis of the range creates several
and then Ekind (Homonym (Ent)) = E_Label
then
Set_Entity (Id, Ent);
- Set_Ekind (Ent, E_Loop);
+ Mutate_Ekind (Ent, E_Loop);
end if;
else
if Ekind (Ent) = E_Label then
Reinit_Field_To_Zero (Ent, Enclosing_Scope);
- Set_Ekind (Ent, E_Loop);
+ Mutate_Ekind (Ent, E_Loop);
if Nkind (Parent (Ent)) = N_Implicit_Label_Declaration then
Set_Label_Construct (Parent (Ent), N);
if not Of_Present (I_Spec)
or else not Is_Variable (Name (I_Spec))
then
- Set_Ekind (Id, E_Loop_Parameter);
+ Mutate_Ekind (Id, E_Loop_Parameter);
end if;
end;
end if;
if Nkind (N) = N_Subprogram_Body_Stub then
- Set_Ekind (Defining_Entity (Specification (N)), Kind);
+ Mutate_Ekind (Defining_Entity (Specification (N)), Kind);
else
Set_Corresponding_Spec (N, Gen_Id);
end if;
-- Visible generic entity is callable within its own body
- Set_Ekind (Gen_Id, Ekind (Body_Id));
+ Mutate_Ekind (Gen_Id, Ekind (Body_Id));
Reinit_Field_To_Zero (Body_Id, Has_Out_Or_In_Out_Parameter,
Old_Ekind =>
(E_Function | E_Procedure |
E_Generic_Function | E_Generic_Procedure => True,
others => False));
- Set_Ekind (Body_Id, E_Subprogram_Body);
+ Mutate_Ekind (Body_Id, E_Subprogram_Body);
Set_Convention (Body_Id, Convention (Gen_Id));
Set_Is_Obsolescent (Body_Id, Is_Obsolescent (Gen_Id));
Set_Scope (Body_Id, Scope (Gen_Id));
-- No body to analyze, so restore state of generic unit
- Set_Ekind (Gen_Id, Kind);
- Set_Ekind (Body_Id, Kind);
+ Mutate_Ekind (Gen_Id, Kind);
+ Mutate_Ekind (Body_Id, Kind);
if Present (First_Ent) then
Set_First_Entity (Gen_Id, First_Ent);
Reinit_Field_To_Zero (Gen_Id, Has_Nested_Subprogram,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
- Set_Ekind (Gen_Id, Kind);
+ Mutate_Ekind (Gen_Id, Kind);
Generate_Reference (Gen_Id, Body_Id, 'b', Set_Ref => False);
if Style_Check then
if Present (Prev) and then Is_Generic_Subprogram (Prev) then
Insert_Before (N, Null_Body);
- Set_Ekind (Defining_Entity (N), Ekind (Prev));
+ Mutate_Ekind (Defining_Entity (N), Ekind (Prev));
Rewrite (N, Make_Null_Statement (Loc));
Analyze_Generic_Subprogram_Body (Null_Body, Prev);
Reinit_Field_To_Zero (Body_Id, Receiving_Entry);
end if;
- Set_Ekind (Body_Id, E_Subprogram_Body);
+ Mutate_Ekind (Body_Id, E_Subprogram_Body);
if Nkind (N) = N_Subprogram_Body_Stub then
Set_Corresponding_Spec_Of_Stub (N, Spec_Id);
end if;
if Nkind (N) = N_Function_Specification then
- Set_Ekind (Designator, E_Function);
+ Mutate_Ekind (Designator, E_Function);
Set_Mechanism (Designator, Default_Mechanism);
else
- Set_Ekind (Designator, E_Procedure);
+ Mutate_Ekind (Designator, E_Procedure);
Set_Etype (Designator, Standard_Void_Type);
end if;
return Empty;
end if;
- Set_Ekind (EF, E_In_Parameter);
+ Mutate_Ekind (EF, E_In_Parameter);
Set_Actual_Subtype (EF, Typ);
Set_Etype (EF, Typ);
Set_Scope (EF, Scope);
end if;
if In_Present (Spec) then
- Set_Ekind (Formal_Id, E_In_Out_Parameter);
+ Mutate_Ekind (Formal_Id, E_In_Out_Parameter);
else
- Set_Ekind (Formal_Id, E_Out_Parameter);
+ Mutate_Ekind (Formal_Id, E_Out_Parameter);
end if;
-- But not in earlier versions of Ada
else
Error_Msg_N ("functions can only have IN parameters", Spec);
- Set_Ekind (Formal_Id, E_In_Parameter);
+ Mutate_Ekind (Formal_Id, E_In_Parameter);
end if;
elsif In_Present (Spec) then
- Set_Ekind (Formal_Id, E_In_Out_Parameter);
+ Mutate_Ekind (Formal_Id, E_In_Out_Parameter);
else
- Set_Ekind (Formal_Id, E_Out_Parameter);
+ Mutate_Ekind (Formal_Id, E_Out_Parameter);
Set_Never_Set_In_Source (Formal_Id, True);
Set_Is_True_Constant (Formal_Id, False);
Set_Current_Value (Formal_Id, Empty);
end if;
else
- Set_Ekind (Formal_Id, E_In_Parameter);
+ Mutate_Ekind (Formal_Id, E_In_Parameter);
end if;
-- Set Is_Known_Non_Null for access parameters since the language
-- unannotated body will be used in all instantiations.
Body_Id := Defining_Entity (N);
- Set_Ekind (Body_Id, E_Package_Body);
+ Mutate_Ekind (Body_Id, E_Package_Body);
Set_Scope (Body_Id, Scope (Spec_Id));
Set_Is_Obsolescent (Body_Id, Is_Obsolescent (Spec_Id));
Set_Body_Entity (Spec_Id, Body_Id);
-- current node otherwise. Note that N was rewritten above, so we must
-- be sure to get the latest Body_Id value.
- Set_Ekind (Body_Id, E_Package_Body);
+ Mutate_Ekind (Body_Id, E_Package_Body);
Set_Body_Entity (Spec_Id, Body_Id);
Set_Spec_Entity (Body_Id, Spec_Id);
Generate_Definition (Id);
Enter_Name (Id);
- Set_Ekind (Id, E_Package);
+ Mutate_Ekind (Id, E_Package);
Set_Etype (Id, Standard_Void_Type);
-- Set SPARK_Mode from context
end if;
if Limited_Present (Def) then
- Set_Ekind (Id, E_Limited_Private_Type);
+ Mutate_Ekind (Id, E_Limited_Private_Type);
else
- Set_Ekind (Id, E_Private_Type);
+ Mutate_Ekind (Id, E_Private_Type);
end if;
Set_Etype (Id, Id);
Set_Private_Dependents (Id, New_Elmt_List);
if Tagged_Present (Def) then
- Set_Ekind (Id, E_Record_Type_With_Private);
+ Mutate_Ekind (Id, E_Record_Type_With_Private);
Set_Direct_Primitive_Operations (Id, New_Elmt_List);
Set_Is_Abstract_Type (Id, Abstract_Present (Def));
Set_Is_Limited_Record (Id, Limited_Present (Def));
Enter_Name (Id);
Analyze (Nam);
- Set_Ekind (Id, E_Exception);
+ Mutate_Ekind (Id, E_Exception);
Set_Etype (Id, Standard_Exception_Type);
Set_Is_Pure (Id, Is_Pure (Current_Scope));
end if;
Enter_Name (New_P);
- Set_Ekind (New_P, K);
+ Mutate_Ekind (New_P, K);
if Etype (Old_P) = Any_Type then
null;
Error_Msg_N
("object name or value expected in renaming", Nam);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
Set_Etype (Id, Any_Type);
return;
Error_Msg_N
("object name or value expected in renaming", Nam);
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
Set_Etype (Id, Any_Type);
return;
and then Comes_From_Source (N)
then
Set_Etype (Id, T);
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
Rewrite (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Id,
-- want to change it to a variable.
if Ekind (Id) /= E_Constant then
- Set_Ekind (Id, E_Variable);
+ Mutate_Ekind (Id, E_Variable);
end if;
Init_Object_Size_Align (Id);
Set_Etype (Id, T2);
if not Is_Variable (Nam) then
- Set_Ekind (Id, E_Constant);
+ Mutate_Ekind (Id, E_Constant);
Set_Never_Set_In_Source (Id, True);
Set_Is_True_Constant (Id, True);
end if;
-- Set basic attributes to minimize cascaded errors
- Set_Ekind (New_P, E_Package);
+ Mutate_Ekind (New_P, E_Package);
Set_Etype (New_P, Standard_Void_Type);
elsif Present (Renamed_Entity (Old_P))
-- Set basic attributes to minimize cascaded errors
- Set_Ekind (New_P, E_Package);
+ Mutate_Ekind (New_P, E_Package);
Set_Etype (New_P, Standard_Void_Type);
-- Here for OK package renaming
-- entity. The simplest implementation is to have both packages share
-- the entity list.
- Set_Ekind (New_P, E_Package);
+ Mutate_Ekind (New_P, E_Package);
Set_Etype (New_P, Standard_Void_Type);
if Present (Renamed_Object (Old_P)) then
Reinit_Field_To_Zero (New_S, Has_Out_Or_In_Out_Parameter);
Reinit_Field_To_Zero (New_S, Needs_No_Actuals,
Old_Ekind => (E_Function | E_Procedure => True, others => False));
- Set_Ekind (New_S, E_Subprogram_Body);
+ Mutate_Ekind (New_S, E_Subprogram_Body);
New_S := Rename_Spec;
Set_Has_Completion (Rename_Spec, False);
Analyze (Formals);
if Present (Entry_Index_Specification (Formals)) then
- Set_Ekind (Id, E_Entry_Family);
+ Mutate_Ekind (Id, E_Entry_Family);
else
- Set_Ekind (Id, E_Entry);
+ Mutate_Ekind (Id, E_Entry);
end if;
Set_Etype (Id, Standard_Void_Type);
-- Case of no discrete subtype definition
if No (D_Sdef) then
- Set_Ekind (Def_Id, E_Entry);
+ Mutate_Ekind (Def_Id, E_Entry);
-- Processing for discrete subtype definition present
else
Enter_Name (Def_Id);
- Set_Ekind (Def_Id, E_Entry_Family);
+ Mutate_Ekind (Def_Id, E_Entry_Family);
Analyze (D_Sdef);
Make_Index (D_Sdef, N, Def_Id);
Make_Index (Def, N);
end if;
- Set_Ekind (Loop_Id, E_Loop);
+ Mutate_Ekind (Loop_Id, E_Loop);
Set_Scope (Loop_Id, Current_Scope);
Push_Scope (Loop_Id);
Enter_Name (Iden);
- Set_Ekind (Iden, E_Entry_Index_Parameter);
+ Mutate_Ekind (Iden, E_Entry_Index_Parameter);
Set_Etype (Iden, Etype (Def));
end Analyze_Entry_Index_Specification;
Freeze_Previous_Contracts (N);
Tasking_Used := True;
- Set_Ekind (Body_Id, E_Protected_Body);
+ Mutate_Ekind (Body_Id, E_Protected_Body);
Set_Etype (Body_Id, Standard_Void_Type);
Spec_Id := Find_Concurrent_Spec (Body_Id);
Set_Completion_Referenced (T);
end if;
- Set_Ekind (T, E_Protected_Type);
+ Mutate_Ekind (T, E_Protected_Type);
Set_Is_First_Subtype (T);
Init_Size_Align (T);
Set_Etype (T, T);
E := First_Entity (Current_Scope);
while Present (E) loop
if Ekind (E) = E_Void then
- Set_Ekind (E, E_Component);
+ Mutate_Ekind (E, E_Component);
Init_Component_Location (E);
end if;
-- its own body.
Enter_Name (Typ);
- Set_Ekind (Typ, E_Protected_Type);
+ Mutate_Ekind (Typ, E_Protected_Type);
Set_Etype (Typ, Typ);
Set_Anonymous_Object (Typ, Obj_Id);
Enter_Name (Obj_Id);
- Set_Ekind (Obj_Id, E_Variable);
+ Mutate_Ekind (Obj_Id, E_Variable);
Set_Etype (Obj_Id, Typ);
Set_SPARK_Pragma (Obj_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Obj_Id);
-- in its own body.
Enter_Name (Typ);
- Set_Ekind (Typ, E_Task_Type);
+ Mutate_Ekind (Typ, E_Task_Type);
Set_Etype (Typ, Typ);
Set_Anonymous_Object (Typ, Obj_Id);
Enter_Name (Obj_Id);
- Set_Ekind (Obj_Id, E_Variable);
+ Mutate_Ekind (Obj_Id, E_Variable);
Set_Etype (Obj_Id, Typ);
Set_SPARK_Pragma (Obj_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Obj_Id);
Tasking_Used := True;
Set_Scope (Body_Id, Current_Scope);
- Set_Ekind (Body_Id, E_Task_Body);
+ Mutate_Ekind (Body_Id, E_Task_Body);
Set_Etype (Body_Id, Standard_Void_Type);
Spec_Id := Find_Concurrent_Spec (Body_Id);
Set_Completion_Referenced (T);
else
- Set_Ekind (T, E_Task_Type);
+ Mutate_Ekind (T, E_Task_Type);
Set_Corresponding_Record_Type (T, Empty);
end if;
end if;
- Set_Ekind (T, E_Task_Type);
+ Mutate_Ekind (T, E_Task_Type);
Set_Is_First_Subtype (T, True);
Set_Has_Task (T, True);
Init_Size_Align (T);
-- Corresponding_Remote_Type attribute, whose presence indicates that
-- this is the record type used to implement a RAS.
- Set_Ekind (Fat_Type, E_Record_Type);
+ Mutate_Ekind (Fat_Type, E_Record_Type);
Set_Corresponding_Remote_Type (Fat_Type, User_Type);
Insert_After_And_Analyze (Subpkg_Body, Fat_Type_Decl);
-- Partially decorate the elaboration procedure because it will not
-- be insertred into the tree and analyzed.
- Set_Ekind (Proc_Id, E_Procedure);
+ Mutate_Ekind (Proc_Id, E_Procedure);
Set_Etype (Proc_Id, Standard_Void_Type);
Set_Scope (Proc_Id, Unique_Entity (Main_Unit_Entity));
-- it will not be inserted into the tree and analyzed.
Task_Obj := Make_Temporary (Loc, 'T');
- Set_Ekind (Task_Obj, E_Variable);
+ Mutate_Ekind (Task_Obj, E_Variable);
Set_Etype (Task_Obj, Task_Typ);
-- Associate the dummy task object with the activation call
Set_Comes_From_Source (State_Id, not Is_Null);
Set_Parent (State_Id, State);
- Set_Ekind (State_Id, E_Abstract_State);
+ Mutate_Ekind (State_Id, E_Abstract_State);
Set_Etype (State_Id, Standard_Void_Type);
Set_Encapsulating_State (State_Id, Empty);
-- will be detected. Any_Type insures that no cascaded errors will occur
else
- Set_Ekind (Def_Id, E_Void);
+ Mutate_Ekind (Def_Id, E_Void);
Set_Etype (Def_Id, Any_Type);
end if;
(Chars (Related_Id), Suffix, Suffix_Index, Prefix));
begin
- Set_Ekind (N, Kind);
+ Mutate_Ekind (N, Kind);
Set_Is_Internal (N, True);
Append_Entity (N, Scope_Id);
Set_Public_Status (N);
N : constant Entity_Id := Make_Temporary (Sloc_Value, Id_Char);
begin
- Set_Ekind (N, Kind);
+ Mutate_Ekind (N, Kind);
Set_Is_Internal (N, True);
Append_Entity (N, Scope_Id);
(Loc, Access_Type_Id,
Type_Definition => Access_Type_Def);
begin
- Set_Ekind (Temp_Id, E_Variable);
+ Mutate_Ekind (Temp_Id, E_Variable);
Set_Etype (Temp_Id, Access_Type_Id);
- Set_Ekind (Access_Type_Id, E_Access_Type);
+ Mutate_Ekind (Access_Type_Id, E_Access_Type);
if Append_Decls_In_Reverse_Order then
Append_Item (Temp_Decl, Is_Eval_Stmt => False);
-- --
------------------------------------------------------------------------------
--- This package defines the structure of the abstract syntax tree. The Tree
+-- This package documents the structure of the abstract syntax tree. The Atree
-- package provides a basic tree structure. Sinfo describes how this structure
-- is used to represent the syntax of an Ada program.
-- would normally be regarded as the symbol table information. In addition a
-- number of the tree nodes contain semantic information.
--- WARNING: Several files are automatically generated from this package.
--- See below for details.
+-- See the spec of Gen_IL.Gen for instructions on making changes to this file.
+-- Note that the official definition of what nodes have what fields is in
+-- Gen_IL.Gen.Gen_Nodes; if there is a discrepancy between that and the
+-- comments here, Gen_IL.Gen.Gen_Nodes wins.
+--
+-- Offsets of each field are given in parentheses below, but this information
+-- is obsolete, and should be completely ignored. The actual field offsets are
+-- determined by the Gen_IL program. We might want to remove these comments at
+-- some point.
pragma Warnings (Off); -- with/use clauses for children
with Namet; use Namet;
package Sinfo is
- -- ????Comments below are partly obsolete
-
- ---------------------------------
- -- Making Changes to This File --
- ---------------------------------
-
- -- If changes are made to this file, a number of related steps must be
- -- carried out to ensure consistency. First, if a field access function is
- -- added, it appears in these places:
-
- -- In sinfo.ads:
- -- The documentation associated with the field (if semantic)
- -- The documentation associated with the node
- -- The spec of the access function
- -- The spec of the set procedure
- -- The entries in Is_Syntactic_Field
- -- The pragma Inline for the access function
- -- The pragma Inline for the set procedure
- -- In sinfo.adb:
- -- The body of the access function
- -- The body of the set procedure
-
- -- The field chosen must be consistent in all places, and, for a node that
- -- is a subexpression, must not overlap any of the standard expression
- -- fields.
-
- -- In addition, if any of the standard expression fields is changed, then
- -- the utility program which creates the Treeprs spec (in file treeprs.ads)
- -- must be updated appropriately, since it special cases expression fields.
-
- -- If a new tree node is added, then the following changes are made:
-
- -- Add it to the documentation in the appropriate place
- -- Add its fields to this documentation section
- -- Define it in the appropriate classification in Node_Kind
- -- Add an entry in Is_Syntactic_Field
- -- In the body (sinfo), add entries to the access functions for all
- -- its fields (except standard expression fields) to include the new
- -- node in the checks.
- -- Add an appropriate section to the case statement in sprint.adb
- -- Add an appropriate section to the case statement in sem.adb
- -- Add an appropriate section to the case statement in exp_util.adb
- -- (Insert_Actions procedure)
- -- For a subexpression, add an appropriate section to the case
- -- statement in sem_eval.adb
- -- For a subexpression, add an appropriate section to the case
- -- statement in sem_res.adb
-
- -- All back ends must be made aware of the new node kind.
-
- -- Finally, four utility programs must be run:
-
- -- (Optional.) Run CSinfo to check that you have made the changes
- -- consistently. It checks most of the rules given above. This utility
- -- reads sinfo.ads and sinfo.adb and generates a report to standard
- -- output. This step is optional because XSinfo runs CSinfo.
-
- -- Run XSinfo to create sinfo.h, the corresponding C header. This
- -- utility reads sinfo.ads and generates sinfo.h. Note that it does
- -- not need to read sinfo.adb, since the contents of the body are
- -- algorithmically determinable from the spec.
-
- -- Run XTreeprs to create treeprs.ads, an updated version of the module
- -- that is used to drive the tree print routine. This utility reads (but
- -- does not modify) treeprs.adt, the template that provides the basic
- -- structure of the file, and then fills in the data from the comments
- -- in sinfo.ads.
-
- -- Run XNmake to create nmake.ads and nmake.adb, the package body and
- -- spec of the Nmake package which contains functions for constructing
- -- nodes.
-
- -- The above steps are done automatically by the build scripts when you do
- -- a full bootstrap.
-
- -- Note: sometime we could write a utility that actually generated the body
- -- of sinfo from the spec instead of simply checking it, since, as noted
- -- above, the contents of the body can be determined from the spec.
+ ----------------------------------------
+ -- Definitions of fields in tree node --
+ ----------------------------------------
+
+ -- The following fields are common to all nodes:
+
+ -- Nkind Indicates the kind of the node. This field is present
+ -- in all nodes.
+
+ -- Sloc Location (Source_Ptr) of the corresponding token
+ -- in the Source buffer. The individual node definitions
+ -- show which token is referenced by this pointer.
+
+ -- In_List A flag used to indicate if the node is a member
+ -- of a node list (see package Nlists).
+
+ -- Rewrite_Ins A flag set if a node is marked as a rewrite inserted
+ -- node as a result of a call to Mark_Rewrite_Insertion.
+
+ -- Small_Paren_Count
+ -- A 2-bit count used in subexpression nodes to indicate
+ -- the level of parentheses. The settings are 0,1,2 and
+ -- 3 for many. If the value is 3, then an auxiliary table
+ -- is used to indicate the real value, which is computed by
+ -- Paren_Count. Set to zero for nonsubexpression nodes.
+
+ -- Note: the required parentheses surrounding conditional
+ -- and quantified expressions count as a level of parens
+ -- for this purpose, so e.g. in X := (if A then B else C);
+ -- Paren_Count for the right side will be 1.
+
+ -- Comes_From_Source
+ -- This flag is present in all nodes. It is set if the
+ -- node is built by the scanner or parser, and clear if
+ -- the node is built by the analyzer or expander. It
+ -- indicates that the node corresponds to a construct
+ -- that appears in the original source program.
+
+ -- Analyzed This flag is present in all nodes. It is set when
+ -- a node is analyzed, and is used to avoid analyzing
+ -- the same node twice. Analysis includes expansion if
+ -- expansion is active, so in this case if the flag is
+ -- set it means the node has been analyzed and expanded.
+
+ -- Error_Posted This flag is present in all nodes. It is set when
+ -- an error message is posted which is associated with
+ -- the flagged node. This is used to avoid posting more
+ -- than one message on the same node.
+
+ -- Link For a node, points to the Parent. For a list, points
+ -- to the list header. Note that in the latter case, a
+ -- client cannot modify the link field. This field is
+ -- private to the Atree package (but is also modified
+ -- by the Nlists package).
+
+ -- The following additional fields are common to all entities (that is,
+ -- nodes whose Nkind is in N_Entity):
+
+ -- Ekind Entity type.
+
+ -- Convention Entity convention (Convention_Id value)
--------------------------------
-- Implicit Nodes in the Tree --
-- expansion of aggregates is also used for in-place array aggregate
-- assignment or initialization. When the full context is known, the
-- target of the assignment or initialization is used to generate the
- -- left-hand side of individual assignment to each sub-component.
+ -- left-hand side of individual assignment to each subcomponent.
-- Expression_Copy (Node2-Sem)
-- Present in N_Pragma_Argument_Association nodes. Contains a copy of the
projects / platform / upstream / gcc.git / commitdiff