| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- A T R E E -- |
| -- -- |
| -- S p e c -- |
| -- -- |
| -- Copyright (C) 1992-2022, 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; |
| 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 |
| |
| 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. |
| -- Initialized for -gnatVa use, see comment above. |
| |
| -- 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. Initialized for -gnatVa use, see comment above. |
| |
| Warnings_Detected : Nat := 0; |
| -- Number of warnings detected. Initialized to zero at the start of |
| -- compilation. Initialized for -gnatVa use, see comment above. 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 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, i.e. it never generates an extended node. |
| -- |
| -- 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 |
| -- and returns an extended node. |
| |
| 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. Both normal and extended nodes (entities) may be |
| -- copied using New_Copy. |
| |
| 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 function is used only 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 Parent (N : Node_Or_Entity_Id) return Node_Or_Entity_Id; |
| 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. |
| |
| 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_Parent (N : Node_Or_Entity_Id; Val : Node_Or_Entity_Id); |
| 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). Neither Old_Node nor New_Node can be extended nodes. |
| -- ??? 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. |
| |
| 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). 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 |
| -- E_Void, then back to the something else, and we expect the "something |
| -- else" fields to retain their value. The two "something else"s are not |
| -- always the same; for example we change from E_Void, to E_Variable, to |
| -- E_Void, to E_Constant. |
| |
| 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; |
