path: root/gcc/ada/atree.ads

------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                A T R E E                                 --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--          Copyright (C) 1992-2024, Free Software Foundation, Inc.         --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

--  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.

--  WARNING: There is a C++ version of this package. Any changes to this source
--  file must be properly reflected in the C++ header file atree.h.

--  Package Atree defines the basic structure of the tree and its nodes and
--  provides the basic abstract interface for manipulating the tree. Two other
--  packages use this interface to define the representation of Ada programs
--  using this tree format. The package Sinfo defines the basic representation
--  of the syntactic structure of the program, as output by the parser. The
--  package Einfo defines the semantic information that is added to the tree
--  nodes that represent declared entities (i.e. the information that is
--  described in a separate symbol table structure in some other compilers).

--  The front end of the compiler first parses the program and generates a
--  tree that is simply a syntactic representation of the program in abstract
--  syntax tree format. Subsequent processing in the front end traverses the
--  tree, transforming it in various ways and adding semantic information.

with Alloc;
with Sinfo.Nodes;    use Sinfo.Nodes;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils;    use Einfo.Utils;
with Types;          use Types;
with Seinfo;         use Seinfo;
with System;         use System;
with Table;

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

   function Node_Offsets_Address return System.Address;
   function Slots_Address return System.Address;
   --  Address of Node_Offsets.Table and Slots.Table. Used in Back_End for Gigi
   --  call.

   function Approx_Num_Nodes_And_Entities return Nat;
   --  This is an approximation to the number of nodes and entities allocated,
   --  used to determine sizes of hash tables.

   -----------------------
   -- Use of Empty Node --
   -----------------------

   --  The special Node_Id Empty is used to mark missing fields, similar to
   --  "null" in Ada. Whenever the syntax has an optional component, then the
   --  corresponding field will be set to Empty if the component is missing.

   --  Note: Empty is not used to describe an empty list. Instead in this
   --  case the node field contains a list which is empty, and these cases
   --  should be distinguished (essentially from a type point of view, Empty
   --  is a Node, not a list).

   --  Note: Empty does in fact correspond to an allocated node. The Nkind
   --  field of this node may be referenced. It contains N_Empty, which
   --  uniquely identifies the empty case. This allows the Nkind field to be
   --  dereferenced before the check for Empty which is sometimes useful. We
   --  also access certain other fields of Empty; see comments in
   --  Gen_IL.Gen.Gen_Nodes.

   -----------------------
   -- Use of Error Node --
   -----------------------

   --  The Error node is used during syntactic and semantic analysis to
   --  indicate that the corresponding piece of syntactic structure or
   --  semantic meaning cannot properly be represented in the tree because
   --  of an illegality in the program.

   --  If an Error node is encountered, then you know that a previous
   --  illegality has been detected. The proper reaction should be to
   --  avoid posting related cascaded error messages, and to propagate
   --  the Error node if necessary.

   ------------------------
   -- Current_Error_Node --
   ------------------------

   --  Current_Error_Node is a global variable indicating the current node
   --  that is being processed for the purposes of placing a compiler
   --  abort message. This is not necessarily perfectly accurate, it is
   --  just a reasonably accurate best guess. It is used to output the
   --  source location in the abort message by Comperr, and also to
   --  implement the d3 debugging flag.

   --  There are two ways this gets set. During parsing, when new source
   --  nodes are being constructed by calls to New_Node and New_Entity,
   --  either one of these calls sets Current_Error_Node to the newly
   --  created node. During semantic analysis, this mechanism is not
   --  used, and instead Current_Error_Node is set by the subprograms in
   --  Debug_A that mark the start and end of analysis/expansion of a
   --  node in the tree.

   --  Current_Error_Node is also used for other purposes. See, for example,
   --  Rtsfind.

   Current_Error_Node : Node_Id := Empty;
   --  Node to place compiler abort messages

   ------------------
   -- Error Counts --
   ------------------

   --  The following variables denote the count of errors of various kinds
   --  detected in the tree. Note that these might be more logically located in
   --  Err_Vars, but we put it here to deal with licensing issues (we need this
   --  to have the GPL exception licensing, since Check_Error_Detected can be
   --  called from units with this licensing).

   Serious_Errors_Detected : Nat := 0;
   --  This is a count of errors that are serious enough to stop expansion,
   --  and hence to prevent generation of an object file even if the
   --  switch -gnatQ is set. Initialized to zero at the start of compilation.

   --  WARNING: There is a matching C declaration of this variable in fe.h

   Total_Errors_Detected : Nat := 0;
   --  Number of errors detected so far. Includes count of serious errors and
   --  non-serious errors, so this value is always greater than or equal to the
   --  Serious_Errors_Detected value. Initialized to zero at the start of
   --  compilation.

   Warnings_Detected : Nat := 0;
   --  Number of warnings detected. Initialized to zero at the start of
   --  compilation. This count includes the count of style and info messages.

   Warning_Info_Messages : Nat := 0;
   --  Number of info messages generated as warnings. Info messages are never
   --  treated as errors (whether from use of the pragma, or the compiler
   --  switch -gnatwe).

   Report_Info_Messages : Nat := 0;
   --  Number of info messages generated as reports. Info messages are never
   --  treated as errors (whether from use of the pragma, or the compiler
   --  switch -gnatwe). Used under Spark_Mode to report proved checks.

   Check_Messages : Nat := 0;
   --  Number of check messages generated. Check messages are neither warnings
   --  nor errors.

   Warnings_Treated_As_Errors : Nat := 0;
   --  Number of warnings changed into errors as a result of matching a pattern
   --  given in a Warning_As_Error configuration pragma.

   Configurable_Run_Time_Violations : Nat := 0;
   --  Count of configurable run time violations so far. This is used to
   --  suppress certain cascaded error messages when we know that we may not
   --  have fully expanded some items, due to high integrity violations (e.g.
   --  the use of constructs not permitted by the library in use, or improper
   --  constructs in No_Run_Time mode).

   procedure Check_Error_Detected;
   --  When an anomaly is found in the tree, many semantic routines silently
   --  bail out, assuming that the anomaly was caused by a previously detected
   --  serious error (or configurable run time violation). This routine should
   --  be called in these cases, and will raise an exception if no such error
   --  has been detected. This ensures that the anomaly is never allowed to go
   --  unnoticed in legal programs.

   --------------------------------------------------
   -- Node Allocation and Modification Subprograms --
   --------------------------------------------------

   --  The following subprograms are used for constructing the tree in the
   --  first place, and then for subsequent modifications as required.

   procedure Initialize;
   --  Called at the start of compilation to make the entries for Empty and
   --  Error.

   procedure Lock;
   --  Called before the back end is invoked to lock the nodes table.
   --  Also called after Unlock to relock.

   procedure Unlock;
   --  Unlocks nodes table, in cases where the back end needs to modify it

   procedure Lock_Nodes;
   --  Called to lock node modifications when assertions are enabled; without
   --  assertions calling this subprogram has no effect. The initial state of
   --  the lock is unlocked.

   procedure Unlock_Nodes;
   --  Called to unlock node modifications when assertions are enabled; if
   --  assertions are not enabled calling this subprogram has no effect.

   function Is_Entity (N : Node_Or_Entity_Id) return Boolean;
   pragma Inline (Is_Entity);
   --  Returns True if N is an entity

   function Is_Syntactic_Node
     (Source : Node_Id;
      Field  : Node_Id)
      return Boolean;
   --  Return True when Field is a syntactic child of node Source. It is called
   --  when creating a copy of Source to preserve the Parent link in the copy
   --  of Field.

   function New_Node
     (New_Node_Kind : Node_Kind;
      New_Sloc      : Source_Ptr) return Node_Id;
   --  Allocates a new node with the given node type and source location
   --  values. Fields have defaults depending on their type:

   --    Flag: False
   --    Node_Id: Empty
   --    List_Id: Empty
   --    Elist_Id: No_Elist
   --    Uint: No_Uint
   --
   --    Name_Id, String_Id, Valid_Uint, Unat, Upos, Nonzero_Uint, Ureal:
   --      No default. This means it is an error to call the getter before
   --      calling the setter.
   --
   --  The usual approach is to build a new node using this function and
   --  then, using the value returned, use the Set_xxx functions to set
   --  fields of the node as required. New_Node can only be used for
   --  non-entity nodes.
   --
   --  If we are currently parsing, as indicated by a previous call to
   --  Set_Comes_From_Source_Default (True), then this call also resets
   --  the value of Current_Error_Node.

   function New_Entity
     (New_Node_Kind : Node_Kind;
      New_Sloc      : Source_Ptr) return Entity_Id;
   --  Similar to New_Node, except that it is used only for entity nodes.

   procedure Set_Comes_From_Source_Default (Default : Boolean);
   --  Sets value of Comes_From_Source flag to be used in all subsequent
   --  New_Node and New_Entity calls until another call to this procedure
   --  changes the default. This value is set True during parsing and
   --  False during semantic analysis. This is also used to determine
   --  if New_Node and New_Entity should set Current_Error_Node.

   function Get_Comes_From_Source_Default return Boolean;
   pragma Inline (Get_Comes_From_Source_Default);
   --  Gets the current value of the Comes_From_Source flag

   procedure Preserve_Comes_From_Source (NewN, OldN : Node_Id);
   pragma Inline (Preserve_Comes_From_Source);
   --  When a node is rewritten, it is sometimes appropriate to preserve the
   --  original comes from source indication. This is true when the rewrite
   --  essentially corresponds to a transformation corresponding exactly to
   --  semantics in the reference manual. This procedure copies the setting
   --  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 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.
   --  The contents of the source node is not affected. If the source node
   --  has an extension, then the destination must have an extension also.
   --  The parent pointer of the destination and its list link, if any, are
   --  not affected by the copy. Note that parent pointers of descendants
   --  are not adjusted, so the descendants of the destination node after
   --  the Copy_Node is completed have dubious parent pointers. Note that
   --  this routine does NOT copy aspect specifications, the Has_Aspects
   --  flag in the returned node will always be False. The caller must deal
   --  with copying aspect specifications where this is required.

   function New_Copy (Source : Node_Id) return Node_Id;
   --  This function allocates a new node, and then initializes it by copying
   --  the contents of the source node into it. The contents of the source node
   --  is not affected. The target node is always marked as not being in a list
   --  (even if the source is a list member), and not overloaded. The new node
   --  will have an extension if the source has an extension. New_Copy (Empty)
   --  returns Empty, and New_Copy (Error) returns Error. Note that, unlike
   --  Copy_Separate_Tree, New_Copy does not recursively copy any descendants,
   --  so in general parent pointers are not set correctly for the descendants
   --  of the copied node.

   function Relocate_Node (Source : Node_Id) return Node_Id;
   --  Source is a non-entity node that is to be relocated. A new node is
   --  allocated, and the contents of Source are copied to this node, using
   --  New_Copy. The parent pointers of descendants of the node are then
   --  adjusted to point to the relocated copy. The original node is not
   --  modified, but the parent pointers of its descendants are no longer
   --  valid. The new copy is always marked as not overloaded. This routine is
   --  used in conjunction with the tree rewrite routines (see descriptions of
   --  Replace/Rewrite).
   --
   --  Note that the resulting node has the same parent as the source node, and
   --  is thus still attached to the tree. It is valid for Source to be Empty,
   --  in which case Relocate_Node simply returns Empty as the result.

   function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
   --  Given a node that is the root of a subtree, Copy_Separate_Tree copies
   --  the entire syntactic subtree, including recursively any descendants
   --  whose parent field references a copied node (descendants not linked to
   --  a copied node by the parent field are also copied.) The parent pointers
   --  in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
   --  Empty/Error. The new subtree does not share entities with the source,
   --  but has new entities with the same name.
   --
   --  Most of the time this routine is called on an unanalyzed tree, and no
   --  semantic information is copied. However, to ensure that no entities
   --  are shared between the two when the source is already analyzed, and
   --  that the result looks like an unanalyzed tree from the parser, Entity
   --  fields and Etype fields are set to Empty, and Analyzed flags set False.
   --
   --  In addition, Expanded_Name nodes are converted back into the original
   --  parser form (where they are Selected_Components), so that reanalysis
   --  does the right thing.

   function Copy_Separate_List (Source : List_Id) return List_Id;
   --  Applies Copy_Separate_Tree to each element of the Source list, returning
   --  a new list of the results of these copy operations.

   procedure Exchange_Entities (E1 : Entity_Id; E2 : Entity_Id);
   --  Exchange the contents of two entities. The parent pointers are switched
   --  as well as the Defining_Identifier fields in the parents, so that the
   --  entities point correctly to their original parents. The effect is thus
   --  to leave the tree unchanged in structure, except that the entity ID
   --  values of the two entities are interchanged. Neither of the two entities
   --  may be list members. Note that entities appear on two semantic chains:
   --  Homonym and Next_Entity: the corresponding links must be adjusted by the
   --  caller, according to context.

   procedure Extend_Node (Source : Node_Id);
   --  This turns a node into an entity; it is only used by Sinfo.CN.

   type Ignored_Ghost_Record_Proc is access procedure (N : Node_Or_Entity_Id);

   procedure Set_Ignored_Ghost_Recording_Proc
     (Proc : Ignored_Ghost_Record_Proc);
   --  Register a procedure that is invoked when an ignored Ghost node or
   --  entity is created.

   type Report_Proc is access procedure (Target : Node_Id; Source : Node_Id);

   procedure Set_Reporting_Proc (Proc : Report_Proc);
   --  Register a procedure that is invoked when a node is allocated, replaced
   --  or rewritten.

   type Rewrite_Proc is access procedure (Target : Node_Id; Source : Node_Id);

   procedure Set_Rewriting_Proc (Proc : Rewrite_Proc);
   --  Register a procedure that is invoked when a node is rewritten

   type Traverse_Result is (Abandon, OK, OK_Orig, Skip);
   --  This is the type of the result returned by the Process function passed
   --  to Traverse_Func and Traverse_Proc. See below for details.

   subtype Traverse_Final_Result is Traverse_Result range Abandon .. OK;
   --  This is the type of the final result returned Traverse_Func, based on
   --  the results of Process calls. See below for details.

   generic
      with function Process (N : Node_Id) return Traverse_Result is <>;
   function Traverse_Func (Node : Node_Id) return Traverse_Final_Result;
   --  This is a generic function that, given the parent node for a subtree,
   --  traverses all syntactic nodes of this tree, calling the given function
   --  Process on each one, in pre order (i.e. top-down). The order of
   --  traversing subtrees is arbitrary. The traversal is controlled as follows
   --  by the result returned by Process:

   --    OK       The traversal continues normally with the syntactic
   --             children of the node just processed.

   --    OK_Orig  The traversal continues normally with the syntactic
   --             children of the original node of the node just processed.

   --    Skip     The children of the node just processed are skipped and
   --             excluded from the traversal, but otherwise processing
   --             continues elsewhere in the tree.

   --    Abandon  The entire traversal is immediately abandoned, and the
   --             original call to Traverse returns Abandon.

   --  The result returned by Traverse is Abandon if processing was terminated
   --  by a call to Process returning Abandon, otherwise it is OK (meaning that
   --  all calls to process returned either OK, OK_Orig, or Skip).

   generic
      with function Process
        (Parent_Node : Node_Id;
         Node        : Node_Id) return Traverse_Result is <>;
   function Traverse_Func_With_Parent
     (Node : Node_Id) return Traverse_Final_Result;
   pragma Inline (Traverse_Func_With_Parent);
   --  Same as Traverse_Func except that the called function Process receives
   --  also the Parent_Node of Node.

   generic
      with function Process (N : Node_Id) return Traverse_Result is <>;
   procedure Traverse_Proc (Node : Node_Id);
   pragma Inline (Traverse_Proc);
   --  This is the same as Traverse_Func except that no result is returned,
   --  i.e. Traverse_Func is called and the result is simply discarded.

   generic
      with function Process
        (Parent_Node : Node_Id;
         Node        : Node_Id) return Traverse_Result is <>;
   procedure Traverse_Proc_With_Parent (Node : Node_Id);
   pragma Inline (Traverse_Proc_With_Parent);
   --  Same as Traverse_Proc except that the called function Process receives
   --  also the Parent_Node of Node.

   ---------------------------
   -- Node Access Functions --
   ---------------------------

   --  The following functions return the contents of the indicated field of
   --  the node referenced by the argument, which is a Node_Id.

   function No (N : Node_Id) return Boolean;
   pragma Inline (No);
   --  Tests given Id for equality with the Empty node. This allows notations
   --  like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".

   function Node_Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id;
   pragma Inline (Node_Parent);
   function Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id
     renames Node_Parent;
   pragma Inline (Parent);
   --  Returns the parent of a node if the node is not a list member, or else
   --  the parent of the list containing the node if the node is a list member.
   --  Parent has the same name as the one in Nlists; Node_Parent can be used
   --  more easily in the debugger.

   function Paren_Count (N : Node_Id) return Nat;
   pragma Inline (Paren_Count);
   --  Number of parentheses that surround an expression

   function Present (N : Node_Id) return Boolean;
   pragma Inline (Present);
   --  Tests given Id for inequality with the Empty node. This allows notations
   --  like "if Present (Statement)" as opposed to "if Statement /= Empty".

   procedure Set_Original_Node (N : Node_Id; Val : Node_Id);
   pragma Inline (Set_Original_Node);
   --  Note that this routine is used only in very peculiar cases. In normal
   --  cases, the Original_Node link is set by calls to Rewrite.

   procedure Set_Node_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id);
   pragma Inline (Set_Node_Parent);
   procedure Set_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id)
     renames Set_Node_Parent;
   pragma Inline (Set_Parent);

   procedure Set_Paren_Count (N : Node_Id; Val : Nat);
   pragma Inline (Set_Paren_Count);

   ---------------------------
   -- Tree Rewrite Routines --
   ---------------------------

   --  During the compilation process it is necessary in a number of situations
   --  to rewrite the tree. In some cases, such rewrites do not affect the
   --  structure of the tree, for example, when an indexed component node is
   --  replaced by the corresponding call node (the parser cannot distinguish
   --  between these two cases).

   --  In other situations, the rewrite does affect the structure of the
   --  tree. Examples are the replacement of a generic instantiation by the
   --  instantiated spec and body, and the static evaluation of expressions.

   --  If such structural modifications are done by the expander, there are
   --  no difficulties, since the form of the tree after the expander has no
   --  special significance, except as input to the backend of the compiler.
   --  However, if these modifications are done by the semantic phase, then
   --  it is important that they be done in a manner which allows the original
   --  tree to be preserved. This is because tools like pretty printers need
   --  to have this original tree structure available.

   --  The subprograms in this section allow rewriting of the tree by either
   --  insertion of new nodes in an existing list, or complete replacement of
   --  a subtree. The resulting tree for most purposes looks as though it has
   --  been really changed, and there is no trace of the original. However,
   --  special subprograms, also defined in this section, allow the original
   --  tree to be reconstructed if necessary.

   --  For tree modifications done in the expander, it is permissible to
   --  destroy the original tree, although it is also allowable to use the
   --  tree rewrite routines where it is convenient to do so.

   procedure Mark_Rewrite_Insertion (New_Node : Node_Id);
   pragma Inline (Mark_Rewrite_Insertion);
   --  This procedure marks the given node as an insertion made during a tree
   --  rewriting operation. Only the root needs to be marked. The call does
   --  not do the actual insertion, which must be done using one of the normal
   --  list insertion routines. The node is treated normally in all respects
   --  except for its response to Is_Rewrite_Insertion. The function of these
   --  calls is to be able to get an accurate original tree. This helps the
   --  accuracy of Sprint.Sprint_Node, and in particular, when stubs are being
   --  generated, it is essential that the original tree be accurate.

   function Is_Rewrite_Insertion (Node : Node_Id) return Boolean;
   pragma Inline (Is_Rewrite_Insertion);
   --  Tests whether the given node was marked using Mark_Rewrite_Insertion.
   --  This is used in reconstructing the original tree (where such nodes are
   --  to be eliminated).

   procedure Rewrite (Old_Node, New_Node : Node_Id);
   --  This is used when a complete subtree is to be replaced. Old_Node is the
   --  root of the old subtree to be replaced, and New_Node is the root of the
   --  newly constructed replacement subtree. The actual mechanism is to swap
   --  the contents of these two nodes fixing up the parent pointers of the
   --  replaced node (we do not attempt to preserve parent pointers for the
   --  original node).
   --  ??? The above explanation is incorrect, instead Copy_Node is called.
   --
   --  Note: New_Node may 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: The Original_Node function applied to Old_Node (which has now
   --  been replaced by the contents of New_Node), can be used to obtain the
   --  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. 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.
   --  Replace also preserves the setting of Comes_From_Source.
   --
   --  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).
   --
   --  Replace is used in certain circumstances where it is desirable to
   --  suppress any history of the rewriting operation. Notably, it is used
   --  when the parser has mis-classified a node (e.g. a task entry call
   --  that the parser has parsed as a procedure call).

   function Is_Rewrite_Substitution (Node : Node_Id) return Boolean;
   pragma Inline (Is_Rewrite_Substitution);
   --  Return True iff Node has been rewritten (i.e. if Node is the root
   --  of a subtree which was installed using Rewrite).

   function Original_Node (Node : Node_Id) return Node_Id;
   pragma Inline (Original_Node);
   --  If Node has not been rewritten, then returns its input argument
   --  unchanged, else returns the Node for the original subtree. See section
   --  in sinfo.ads for requirements on original nodes returned by this
   --  function.
   --
   --  Note: Parents are not preserved in original tree nodes that are
   --  retrieved in this way (i.e. their children may have children whose
   --  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
   --  Rewrite to substitute a null statement for the node to be deleted.

   ----------------------
   -- Vanishing Fields --
   ----------------------

   --  The Nkind and Ekind fields are like Ada discriminants governing a
   --  variant part. They determine which fields are present. If the Nkind
   --  or Ekind fields are changed, then this can change which fields are
   --  present. If a field is present for the old kind, but not for the
   --  new kind, the field vanishes. This requires some care when changing
   --  kinds, as described below. Note that Ada doesn't even allow direct
   --  modification of a discriminant.

   type Node_Field_Set is array (Node_Field) of Boolean with Pack;

   type Entity_Field_Set is array (Entity_Field) of Boolean with Pack;

   procedure Reinit_Field_To_Zero (N : Node_Id; Field : Node_Or_Entity_Field);
   --  When a node is created, all fields are initialized to zero, even if zero
   --  is not a valid value of the field type. This procedure puts the field
   --  back to its initial zero value. Note that you can't just do something
   --  like Set_Some_Field (N, 0), if Some_Field is of (say) type Uintp,
   --  because Uintp is a subrange that does not include 0.
   type Entity_Kind_Set is array (Entity_Kind) of Boolean with Pack;
   procedure Reinit_Field_To_Zero
     (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind_Set);
   procedure Reinit_Field_To_Zero
     (N : Node_Id; Field : Entity_Field; Old_Ekind : Entity_Kind);
   --  Same as above, but assert that the old Ekind is as specified. We might
   --  want to get rid of these, but it's useful documentation while working on
   --  this.

   function Field_Is_Initial_Zero
     (N : Node_Id; Field : Node_Or_Entity_Field) return Boolean;
   --  True if the field value is the initial zero value

   procedure Mutate_Nkind (N : Node_Id; Val : Node_Kind) with Inline;
   --  There is no Set_Nkind in Sinfo.Nodes. We use this instead. This is here,
   --  and has a different name, because it does some extra checking. Nkind is
   --  like a discriminant, in that it controls which fields exist, and that
   --  set of fields can be different for the new kind. Discriminants cannot be
   --  modified in Ada for that reason. The rule here is more flexible: Nkind
   --  can be modified. However, when Nkind is modified, fields that exist for
   --  the old kind, but not for the new kind will vanish. We require that all
   --  vanishing fields be set to their initial zero value before calling
   --  Mutate_Nkind. This is necessary, because the memory occupied by the
   --  vanishing fields might be used for totally unrelated fields in the new
   --  node. See Reinit_Field_To_Zero.
   --
   --  It is an error to mutate a node to the same kind it already has.

   procedure Mutate_Ekind (N : Entity_Id; Val : Entity_Kind) with Inline;
   --  Ekind is also like a discriminant, and is mostly treated as above (see
   --  Mutate_Nkind).
   --
   --  It is not (yet?) an error to mutate an entity to the same kind it
   --  already has. It is an error to mutate to E_Void.

   function Node_To_Fetch_From
     (N : Node_Or_Entity_Id; Field : Node_Or_Entity_Field)
     return Node_Or_Entity_Id is
      (case Field_Descriptors (Field).Type_Only is
         when No_Type_Only => N,
         when Base_Type_Only => Base_Type (N),
         when Impl_Base_Type_Only => Implementation_Base_Type (N),
         when Root_Type_Only => Root_Type (N));
   --  This is analogous to the same-named function in Gen_IL.Gen. Normally,
   --  Type_Only is No_Type_Only, and we fetch the field from the node N. But
   --  if Type_Only = Base_Type_Only, we need to go to the Base_Type, and
   --  similarly for the other two cases. This can return something other
   --  than N only if N is an Entity.

   -----------------------------
   -- Private Part Subpackage --
   -----------------------------

   --  The following package contains the definition of the data structure
   --  used by the implementation of the Atree package. Logically it really
   --  corresponds to the private part, hence the name. The reason that it
   --  is defined as a sub-package is to allow special access from clients
   --  that need to see the internals of the data structures.

   package Atree_Private_Part is

      pragma Assert (Node_Kind'Pos (N_Unused_At_Start) = 0);
      pragma Assert (Empty_List_Or_Node = 0);
      pragma Assert (Entity_Kind'Pos (E_Void) = 0);
      --  We want nodes initialized to zero bits by default

      -------------------------
      -- Tree Representation --
      -------------------------

      --  The nodes of the tree are stored in two tables (i.e. growable
      --  arrays).

      --  A Node_Id points to an element of Node_Offsets, which contains a
      --  Field_Offset that points to an element of Slots. Each slot can
      --  contain a single 32-bit field, or multiple smaller fields.
      --  An n-bit field is aligned on an n-bit boundary. The size of a node is
      --  the number of slots, which can range from 1 up to however many are
      --  needed.
      --
      --  The reason for the extra level of indirection is that Copy_Node,
      --  Exchange_Entities, and Rewrite all assume that nodes can be modified
      --  in place.
      --
      --  As an optimization, we store a few slots directly in the Node_Offsets
      --  table (see type Node_Header) rather than requiring the extra level of
      --  indirection for accessing those slots. N_Head is the number of slots
      --  stored in the Node_Header. N_Head can be adjusted by modifying
      --  Gen_IL.Gen. If N_Head is (say) 3, then a node containing 7 slots will
      --  have slots 0..2 in the header, and 3..6 stored indirect in the Slots
      --  table. We use zero-origin addressing, so the Offset into the Slots
      --  table will point 3 slots before slot 3.

      pragma Assert (N_Head <= Min_Node_Size);
      pragma Assert (N_Head <= Min_Entity_Size);

      Slot_Size : constant := 32;
      type Slot is mod 2**Slot_Size;
      for Slot'Size use Slot_Size;

      --  The type Slot is defined in Types as a 32-bit modular integer. It
      --  is logically split into the appropriate numbers of components of
      --  appropriate size, but this splitting is not explicit because packed
      --  arrays cannot be properly interfaced in C/C++ and packed records are
      --  way too slow.

      type Node_Header_Slots is
        array (Field_Offset range 0 .. N_Head - 1) of Slot;
      type Node_Header is record
         Slots : Node_Header_Slots;
         Offset : Node_Offset'Base;
      end record;
      pragma Assert (Node_Header'Size = (N_Head + 1) * Slot_Size);
      pragma Assert (Node_Header'Size = 16 * 8);

      package Node_Offsets is new Table.Table
        (Table_Component_Type => Node_Header,
         Table_Index_Type     => Node_Id'Base,
         Table_Low_Bound      => First_Node_Id,
         Table_Initial        => Alloc.Node_Offsets_Initial,
         Table_Increment      => Alloc.Node_Offsets_Increment,
         Table_Name           => "Node_Offsets");

      Noff : Node_Offsets.Table_Ptr renames Node_Offsets.Table with
        Unreferenced;
      function Nlast return Node_Id'Base renames Node_Offsets.Last with
        Unreferenced;
      --  Short names for use in gdb, not used in real code. Note that gdb
      --  can't find Node_Offsets.Table without a full expanded name.

      function Shift_Left (S : Slot; V : Natural) return Slot;
      pragma Import (Intrinsic, Shift_Left);

      function Shift_Right (S : Slot; V : Natural) return Slot;
      pragma Import (Intrinsic, Shift_Right);

      --  Low-level types for fields of the various supported sizes.
      --  All fields are a power of 2 number of bits, and are aligned
      --  to that number of bits:

      type Field_Size_1_Bit  is mod 2**1;
      type Field_Size_2_Bit  is mod 2**2;
      type Field_Size_4_Bit  is mod 2**4;
      type Field_Size_8_Bit  is mod 2**8;
      type Field_Size_32_Bit is mod 2**32;

      Slots_Low_Bound : constant Field_Offset := Field_Offset'First + 1;

      package Slots is new Table.Table
        (Table_Component_Type => Slot,
         Table_Index_Type     => Node_Offset'Base,
         Table_Low_Bound      => Slots_Low_Bound,
         Table_Initial        => Alloc.Slots_Initial,
         Table_Increment      => Alloc.Slots_Increment,
         Table_Name           => "Slots");
      --  Note that Table_Low_Bound is set such that if we try to access
      --  Slots.Table (0), we will get Constraint_Error.

      Slts : Slots.Table_Ptr renames Slots.Table with
        Unreferenced;
      function Slast return Node_Offset'Base renames Slots.Last with
        Unreferenced;
      --  Short names for use in gdb, not used in real code. Note that gdb
      --  can't find Slots.Table without a full expanded name.

      function Alloc_Node_Id return Node_Id with Inline;

      function Alloc_Slots (Num_Slots : Slot_Count) return Node_Offset
        with Inline;
      --  Allocate the slots for a node in the Slots table

      --  Each of the following Get_N_Bit_Field functions fetches the field of
      --  the given Field_Type at the given offset. Field_Type'Size must be N.
      --  The offset is measured in units of Field_Type'Size. Likewise for the
      --  Set_N_Bit_Field procedures. These are instantiated in Sinfo.Nodes and
      --  Einfo.Entities for the various possible Field_Types (Flag, Node_Id,
      --  Uint, etc).

      generic
         type Field_Type is private;
      function Get_1_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;

      generic
         type Field_Type is private;
      function Get_2_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;

      generic
         type Field_Type is private;
      function Get_4_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;

      generic
         type Field_Type is private;
      function Get_8_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;

      generic
         type Field_Type is private;
      function Get_32_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;

      generic
         type Field_Type is private;
         Default_Val : Field_Type;
      function Get_32_Bit_Field_With_Default
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;
      --  If the field has not yet been set, return Default_Val

      generic
         type Field_Type is private;
      function Get_Valid_32_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Type
         with Inline;
      --  Assert that the field has already been set. This is currently used
      --  only for Uints, but could be used more generally.

      generic
         type Field_Type is private;
      procedure Set_1_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
         with Inline;

      generic
         type Field_Type is private;
      procedure Set_2_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
         with Inline;

      generic
         type Field_Type is private;
      procedure Set_4_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
         with Inline;

      generic
         type Field_Type is private;
      procedure Set_8_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
         with Inline;

      generic
         type Field_Type is private;
      procedure Set_32_Bit_Field
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Type)
         with Inline;

      --  The following are similar to the above generics, but are not generic,
      --  and work with the low-level Field_n_bit types. If generics could be
      --  overloaded, we would use the same names.

      function Get_1_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_1_Bit
         with Inline;

      function Get_2_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_2_Bit
         with Inline;

      function Get_4_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_4_Bit
         with Inline;

      function Get_8_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_8_Bit
         with Inline;

      function Get_32_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset) return Field_Size_32_Bit
         with Inline;

      procedure Set_1_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_1_Bit)
         with Inline;

      procedure Set_2_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_2_Bit)
         with Inline;

      procedure Set_4_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_4_Bit)
         with Inline;

      procedure Set_8_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_8_Bit)
         with Inline;

      procedure Set_32_Bit_Val
        (N : Node_Or_Entity_Id; Offset : Field_Offset; Val : Field_Size_32_Bit)
         with Inline;

      --  The following are used in "asserts on" mode to validate nodes; an
      --  exception is raised if invalid node content is detected.

      procedure Validate_Node (N : Node_Or_Entity_Id);
      --  Validate for reading
      procedure Validate_Node_Write (N : Node_Or_Entity_Id);
      --  Validate for writing

      function Is_Valid_Node (U : Union_Id) return Boolean;
      --  True if U is within the range of Node_Offsets

      procedure Print_Atree_Info (N : Node_Or_Entity_Id);
      --  Called from Treepr to print out information about N that is private
      --  to Atree.

   end Atree_Private_Part;

   --  Statistics:

   subtype Call_Count is Nat_64;
   Get_Count, Set_Count : array (Node_Or_Entity_Field) of Call_Count :=
     (others => 0);
   --  Number of calls to each getter and setter. See documentaton for
   --  -gnatd.A.

   Get_Original_Node_Count, Set_Original_Node_Count : Call_Count := 0;

   procedure Print_Statistics;

end Atree;