1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 -- This package defines the low-level representation of the tree used to
27 -- represent the Ada program internally. Syntactic and semantic information
28 -- is combined in this tree. There is no separate symbol table structure.
30 -- WARNING: There is a C++ version of this package. Any changes to this source
31 -- file must be properly reflected in the C++ header file atree.h.
33 -- Package Atree defines the basic structure of the tree and its nodes and
34 -- provides the basic abstract interface for manipulating the tree. Two other
35 -- packages use this interface to define the representation of Ada programs
36 -- using this tree format. The package Sinfo defines the basic representation
37 -- of the syntactic structure of the program, as output by the parser. The
38 -- package Einfo defines the semantic information that is added to the tree
39 -- nodes that represent declared entities (i.e. the information that is
40 -- described in a separate symbol table structure in some other compilers).
42 -- The front end of the compiler first parses the program and generates a
43 -- tree that is simply a syntactic representation of the program in abstract
44 -- syntax tree format. Subsequent processing in the front end traverses the
45 -- tree, transforming it in various ways and adding semantic information.
48 with Sinfo
.Nodes
; use Sinfo
.Nodes
;
49 with Einfo
.Entities
; use Einfo
.Entities
;
50 with Einfo
.Utils
; use Einfo
.Utils
;
51 with Types
; use Types
;
52 with Seinfo
; use Seinfo
;
53 with System
; use System
;
58 -- Access to node fields is generally done through the getters and setters
59 -- in packages Sinfo.Nodes and Einfo.Entities, which are automatically
60 -- generated (see Gen_IL.Gen). However, in specialized circumstances
61 -- (examples are the circuit in generic instantiation to copy trees, and in
62 -- the tree dump routine), it is useful to be able to do untyped
63 -- traversals, and an internal package in Atree allows for direct untyped
64 -- accesses in such cases.
66 function Last_Node_Id
return Node_Id
;
67 -- Returns Id of last allocated node Id
69 function Node_Offsets_Address
return System
.Address
;
70 function Slots_Address
return System
.Address
;
71 -- Address of Node_Offsets.Table and Slots.Table. Used in Back_End for Gigi
74 function Approx_Num_Nodes_And_Entities
return Nat
;
75 -- This is an approximation to the number of nodes and entities allocated,
76 -- used to determine sizes of hash tables.
78 -----------------------
79 -- Use of Empty Node --
80 -----------------------
82 -- The special Node_Id Empty is used to mark missing fields, similar to
83 -- "null" in Ada. Whenever the syntax has an optional component, then the
84 -- corresponding field will be set to Empty if the component is missing.
86 -- Note: Empty is not used to describe an empty list. Instead in this
87 -- case the node field contains a list which is empty, and these cases
88 -- should be distinguished (essentially from a type point of view, Empty
89 -- is a Node, not a list).
91 -- Note: Empty does in fact correspond to an allocated node. The Nkind
92 -- field of this node may be referenced. It contains N_Empty, which
93 -- uniquely identifies the empty case. This allows the Nkind field to be
94 -- dereferenced before the check for Empty which is sometimes useful. We
95 -- also access certain other fields of Empty; see comments in
96 -- Gen_IL.Gen.Gen_Nodes.
98 -----------------------
99 -- Use of Error Node --
100 -----------------------
102 -- The Error node is used during syntactic and semantic analysis to
103 -- indicate that the corresponding piece of syntactic structure or
104 -- semantic meaning cannot properly be represented in the tree because
105 -- of an illegality in the program.
107 -- If an Error node is encountered, then you know that a previous
108 -- illegality has been detected. The proper reaction should be to
109 -- avoid posting related cascaded error messages, and to propagate
110 -- the Error node if necessary.
112 ------------------------
113 -- Current_Error_Node --
114 ------------------------
116 -- Current_Error_Node is a global variable indicating the current node
117 -- that is being processed for the purposes of placing a compiler
118 -- abort message. This is not necessarily perfectly accurate, it is
119 -- just a reasonably accurate best guess. It is used to output the
120 -- source location in the abort message by Comperr, and also to
121 -- implement the d3 debugging flag.
123 -- There are two ways this gets set. During parsing, when new source
124 -- nodes are being constructed by calls to New_Node and New_Entity,
125 -- either one of these calls sets Current_Error_Node to the newly
126 -- created node. During semantic analysis, this mechanism is not
127 -- used, and instead Current_Error_Node is set by the subprograms in
128 -- Debug_A that mark the start and end of analysis/expansion of a
131 -- Current_Error_Node is also used for other purposes. See, for example,
134 Current_Error_Node
: Node_Id
:= Empty
;
135 -- Node to place compiler abort messages
141 -- The following variables denote the count of errors of various kinds
142 -- detected in the tree. Note that these might be more logically located in
143 -- Err_Vars, but we put it here to deal with licensing issues (we need this
144 -- to have the GPL exception licensing, since Check_Error_Detected can be
145 -- called from units with this licensing).
147 Serious_Errors_Detected
: Nat
:= 0;
148 -- This is a count of errors that are serious enough to stop expansion,
149 -- and hence to prevent generation of an object file even if the
150 -- switch -gnatQ is set. Initialized to zero at the start of compilation.
152 -- WARNING: There is a matching C declaration of this variable in fe.h
154 Total_Errors_Detected
: Nat
:= 0;
155 -- Number of errors detected so far. Includes count of serious errors and
156 -- non-serious errors, so this value is always greater than or equal to the
157 -- Serious_Errors_Detected value. Initialized to zero at the start of
160 Warnings_Detected
: Nat
:= 0;
161 -- Number of warnings detected. Initialized to zero at the start of
162 -- compilation. This count includes the count of style and info messages.
164 Warning_Info_Messages
: Nat
:= 0;
165 -- Number of info messages generated as warnings. Info messages are never
166 -- treated as errors (whether from use of the pragma, or the compiler
169 Report_Info_Messages
: Nat
:= 0;
170 -- Number of info messages generated as reports. Info messages are never
171 -- treated as errors (whether from use of the pragma, or the compiler
172 -- switch -gnatwe). Used under Spark_Mode to report proved checks.
174 Check_Messages
: Nat
:= 0;
175 -- Number of check messages generated. Check messages are neither warnings
178 Warnings_Treated_As_Errors
: Nat
:= 0;
179 -- Number of warnings changed into errors as a result of matching a pattern
180 -- given in a Warning_As_Error configuration pragma.
182 Configurable_Run_Time_Violations
: Nat
:= 0;
183 -- Count of configurable run time violations so far. This is used to
184 -- suppress certain cascaded error messages when we know that we may not
185 -- have fully expanded some items, due to high integrity violations (e.g.
186 -- the use of constructs not permitted by the library in use, or improper
187 -- constructs in No_Run_Time mode).
189 procedure Check_Error_Detected
;
190 -- When an anomaly is found in the tree, many semantic routines silently
191 -- bail out, assuming that the anomaly was caused by a previously detected
192 -- serious error (or configurable run time violation). This routine should
193 -- be called in these cases, and will raise an exception if no such error
194 -- has been detected. This ensures that the anomaly is never allowed to go
195 -- unnoticed in legal programs.
197 --------------------------------------------------
198 -- Node Allocation and Modification Subprograms --
199 --------------------------------------------------
201 -- The following subprograms are used for constructing the tree in the
202 -- first place, and then for subsequent modifications as required.
204 procedure Initialize
;
205 -- Called at the start of compilation to make the entries for Empty and
209 -- Called before the back end is invoked to lock the nodes table.
210 -- Also called after Unlock to relock.
213 -- Unlocks nodes table, in cases where the back end needs to modify it
215 procedure Lock_Nodes
;
216 -- Called to lock node modifications when assertions are enabled; without
217 -- assertions calling this subprogram has no effect. The initial state of
218 -- the lock is unlocked.
220 procedure Unlock_Nodes
;
221 -- Called to unlock node modifications when assertions are enabled; if
222 -- assertions are not enabled calling this subprogram has no effect.
224 function Is_Entity
(N
: Node_Or_Entity_Id
) return Boolean;
225 pragma Inline
(Is_Entity
);
226 -- Returns True if N is an entity
228 function Is_Syntactic_Node
232 -- Return True when Field is a syntactic child of node Source. It is called
233 -- when creating a copy of Source to preserve the Parent link in the copy
237 (New_Node_Kind
: Node_Kind
;
238 New_Sloc
: Source_Ptr
) return Node_Id
;
239 -- Allocates a new node with the given node type and source location
240 -- values. Fields have defaults depending on their type:
245 -- Elist_Id: No_Elist
248 -- Name_Id, String_Id, Valid_Uint, Unat, Upos, Nonzero_Uint, Ureal:
249 -- No default. This means it is an error to call the getter before
250 -- calling the setter.
252 -- The usual approach is to build a new node using this function and
253 -- then, using the value returned, use the Set_xxx functions to set
254 -- fields of the node as required. New_Node can only be used for
257 -- If we are currently parsing, as indicated by a previous call to
258 -- Set_Comes_From_Source_Default (True), then this call also resets
259 -- the value of Current_Error_Node.
262 (New_Node_Kind
: Node_Kind
;
263 New_Sloc
: Source_Ptr
) return Entity_Id
;
264 -- Similar to New_Node, except that it is used only for entity nodes.
266 procedure Set_Comes_From_Source_Default
(Default
: Boolean);
267 -- Sets value of Comes_From_Source flag to be used in all subsequent
268 -- New_Node and New_Entity calls until another call to this procedure
269 -- changes the default. This value is set True during parsing and
270 -- False during semantic analysis. This is also used to determine
271 -- if New_Node and New_Entity should set Current_Error_Node.
273 function Get_Comes_From_Source_Default
return Boolean;
274 pragma Inline
(Get_Comes_From_Source_Default
);
275 -- Gets the current value of the Comes_From_Source flag
277 procedure Preserve_Comes_From_Source
(NewN
, OldN
: Node_Id
);
278 pragma Inline
(Preserve_Comes_From_Source
);
279 -- When a node is rewritten, it is sometimes appropriate to preserve the
280 -- original comes from source indication. This is true when the rewrite
281 -- essentially corresponds to a transformation corresponding exactly to
282 -- semantics in the reference manual. This procedure copies the setting
283 -- of Comes_From_Source from OldN to NewN.
285 procedure Change_Node
(N
: Node_Id
; New_Kind
: Node_Kind
);
286 -- This procedure replaces the given node by setting its Nkind field to the
287 -- indicated value and resetting all other fields to their default values
288 -- except for certain fields that are preserved (see body for details).
290 procedure Copy_Node
(Source
, Destination
: Node_Or_Entity_Id
);
291 -- Copy the entire contents of the source node to the destination node.
292 -- The contents of the source node is not affected. If the source node
293 -- has an extension, then the destination must have an extension also.
294 -- The parent pointer of the destination and its list link, if any, are
295 -- not affected by the copy. Note that parent pointers of descendants
296 -- are not adjusted, so the descendants of the destination node after
297 -- the Copy_Node is completed have dubious parent pointers. Note that
298 -- this routine does NOT copy aspect specifications, the Has_Aspects
299 -- flag in the returned node will always be False. The caller must deal
300 -- with copying aspect specifications where this is required.
302 function New_Copy
(Source
: Node_Id
) return Node_Id
;
303 -- This function allocates a new node, and then initializes it by copying
304 -- the contents of the source node into it. The contents of the source node
305 -- is not affected. The target node is always marked as not being in a list
306 -- (even if the source is a list member), and not overloaded. The new node
307 -- will have an extension if the source has an extension. New_Copy (Empty)
308 -- returns Empty, and New_Copy (Error) returns Error. Note that, unlike
309 -- Copy_Separate_Tree, New_Copy does not recursively copy any descendants,
310 -- so in general parent pointers are not set correctly for the descendants
311 -- of the copied node.
313 function Relocate_Node
(Source
: Node_Id
) return Node_Id
;
314 -- Source is a non-entity node that is to be relocated. A new node is
315 -- allocated, and the contents of Source are copied to this node, using
316 -- New_Copy. The parent pointers of descendants of the node are then
317 -- adjusted to point to the relocated copy. The original node is not
318 -- modified, but the parent pointers of its descendants are no longer
319 -- valid. The new copy is always marked as not overloaded. This routine is
320 -- used in conjunction with the tree rewrite routines (see descriptions of
323 -- Note that the resulting node has the same parent as the source node, and
324 -- is thus still attached to the tree. It is valid for Source to be Empty,
325 -- in which case Relocate_Node simply returns Empty as the result.
327 function Copy_Separate_Tree
(Source
: Node_Id
) return Node_Id
;
328 -- Given a node that is the root of a subtree, Copy_Separate_Tree copies
329 -- the entire syntactic subtree, including recursively any descendants
330 -- whose parent field references a copied node (descendants not linked to
331 -- a copied node by the parent field are also copied.) The parent pointers
332 -- in the copy are properly set. Copy_Separate_Tree (Empty/Error) returns
333 -- Empty/Error. The new subtree does not share entities with the source,
334 -- but has new entities with the same name.
336 -- Most of the time this routine is called on an unanalyzed tree, and no
337 -- semantic information is copied. However, to ensure that no entities
338 -- are shared between the two when the source is already analyzed, and
339 -- that the result looks like an unanalyzed tree from the parser, Entity
340 -- fields and Etype fields are set to Empty, and Analyzed flags set False.
342 -- In addition, Expanded_Name nodes are converted back into the original
343 -- parser form (where they are Selected_Components), so that reanalysis
344 -- does the right thing.
346 function Copy_Separate_List
(Source
: List_Id
) return List_Id
;
347 -- Applies Copy_Separate_Tree to each element of the Source list, returning
348 -- a new list of the results of these copy operations.
350 procedure Exchange_Entities
(E1
: Entity_Id
; E2
: Entity_Id
);
351 -- Exchange the contents of two entities. The parent pointers are switched
352 -- as well as the Defining_Identifier fields in the parents, so that the
353 -- entities point correctly to their original parents. The effect is thus
354 -- to leave the tree unchanged in structure, except that the entity ID
355 -- values of the two entities are interchanged. Neither of the two entities
356 -- may be list members. Note that entities appear on two semantic chains:
357 -- Homonym and Next_Entity: the corresponding links must be adjusted by the
358 -- caller, according to context.
360 procedure Extend_Node
(Source
: Node_Id
);
361 -- This turns a node into an entity; it is only used by Sinfo.CN.
363 type Ignored_Ghost_Record_Proc
is access procedure (N
: Node_Or_Entity_Id
);
365 procedure Set_Ignored_Ghost_Recording_Proc
366 (Proc
: Ignored_Ghost_Record_Proc
);
367 -- Register a procedure that is invoked when an ignored Ghost node or
368 -- entity is created.
370 type Report_Proc
is access procedure (Target
: Node_Id
; Source
: Node_Id
);
372 procedure Set_Reporting_Proc
(Proc
: Report_Proc
);
373 -- Register a procedure that is invoked when a node is allocated, replaced
376 type Rewrite_Proc
is access procedure (Target
: Node_Id
; Source
: Node_Id
);
378 procedure Set_Rewriting_Proc
(Proc
: Rewrite_Proc
);
379 -- Register a procedure that is invoked when a node is rewritten
381 type Traverse_Result
is (Abandon
, OK
, OK_Orig
, Skip
);
382 -- This is the type of the result returned by the Process function passed
383 -- to Traverse_Func and Traverse_Proc. See below for details.
385 subtype Traverse_Final_Result
is Traverse_Result
range Abandon
.. OK
;
386 -- This is the type of the final result returned Traverse_Func, based on
387 -- the results of Process calls. See below for details.
390 with function Process
(N
: Node_Id
) return Traverse_Result
is <>;
391 function Traverse_Func
(Node
: Node_Id
) return Traverse_Final_Result
;
392 -- This is a generic function that, given the parent node for a subtree,
393 -- traverses all syntactic nodes of this tree, calling the given function
394 -- Process on each one, in pre order (i.e. top-down). The order of
395 -- traversing subtrees is arbitrary. The traversal is controlled as follows
396 -- by the result returned by Process:
398 -- OK The traversal continues normally with the syntactic
399 -- children of the node just processed.
401 -- OK_Orig The traversal continues normally with the syntactic
402 -- children of the original node of the node just processed.
404 -- Skip The children of the node just processed are skipped and
405 -- excluded from the traversal, but otherwise processing
406 -- continues elsewhere in the tree.
408 -- Abandon The entire traversal is immediately abandoned, and the
409 -- original call to Traverse returns Abandon.
411 -- The result returned by Traverse is Abandon if processing was terminated
412 -- by a call to Process returning Abandon, otherwise it is OK (meaning that
413 -- all calls to process returned either OK, OK_Orig, or Skip).
416 with function Process
417 (Parent_Node
: Node_Id
;
418 Node
: Node_Id
) return Traverse_Result
is <>;
419 function Traverse_Func_With_Parent
420 (Node
: Node_Id
) return Traverse_Final_Result
;
421 pragma Inline
(Traverse_Func_With_Parent
);
422 -- Same as Traverse_Func except that the called function Process receives
423 -- also the Parent_Node of Node.
426 with function Process
(N
: Node_Id
) return Traverse_Result
is <>;
427 procedure Traverse_Proc
(Node
: Node_Id
);
428 pragma Inline
(Traverse_Proc
);
429 -- This is the same as Traverse_Func except that no result is returned,
430 -- i.e. Traverse_Func is called and the result is simply discarded.
433 with function Process
434 (Parent_Node
: Node_Id
;
435 Node
: Node_Id
) return Traverse_Result
is <>;
436 procedure Traverse_Proc_With_Parent
(Node
: Node_Id
);
437 pragma Inline
(Traverse_Proc_With_Parent
);
438 -- Same as Traverse_Proc except that the called function Process receives
439 -- also the Parent_Node of Node.
441 ---------------------------
442 -- Node Access Functions --
443 ---------------------------
445 -- The following functions return the contents of the indicated field of
446 -- the node referenced by the argument, which is a Node_Id.
448 function No
(N
: Node_Id
) return Boolean;
450 -- Tests given Id for equality with the Empty node. This allows notations
451 -- like "if No (Variant_Part)" as opposed to "if Variant_Part = Empty".
453 function Node_Parent
(N
: Node_Or_Entity_Id
) return Node_Or_Entity_Id
;
454 pragma Inline
(Node_Parent
);
455 function Parent
(N
: Node_Or_Entity_Id
) return Node_Or_Entity_Id
457 pragma Inline
(Parent
);
458 -- Returns the parent of a node if the node is not a list member, or else
459 -- the parent of the list containing the node if the node is a list member.
460 -- Parent has the same name as the one in Nlists; Node_Parent can be used
461 -- more easily in the debugger.
463 function Paren_Count
(N
: Node_Id
) return Nat
;
464 pragma Inline
(Paren_Count
);
465 -- Number of parentheses that surround an expression
467 function Present
(N
: Node_Id
) return Boolean;
468 pragma Inline
(Present
);
469 -- Tests given Id for inequality with the Empty node. This allows notations
470 -- like "if Present (Statement)" as opposed to "if Statement /= Empty".
472 procedure Set_Original_Node
(N
: Node_Id
; Val
: Node_Id
);
473 pragma Inline
(Set_Original_Node
);
474 -- Note that this routine is used only in very peculiar cases. In normal
475 -- cases, the Original_Node link is set by calls to Rewrite.
477 procedure Set_Node_Parent
(N
: Node_Or_Entity_Id
; Val
: Node_Or_Entity_Id
);
478 pragma Inline
(Set_Node_Parent
);
479 procedure Set_Parent
(N
: Node_Or_Entity_Id
; Val
: Node_Or_Entity_Id
)
480 renames Set_Node_Parent
;
481 pragma Inline
(Set_Parent
);
483 procedure Set_Paren_Count
(N
: Node_Id
; Val
: Nat
);
484 pragma Inline
(Set_Paren_Count
);
486 ---------------------------
487 -- Tree Rewrite Routines --
488 ---------------------------
490 -- During the compilation process it is necessary in a number of situations
491 -- to rewrite the tree. In some cases, such rewrites do not affect the
492 -- structure of the tree, for example, when an indexed component node is
493 -- replaced by the corresponding call node (the parser cannot distinguish
494 -- between these two cases).
496 -- In other situations, the rewrite does affect the structure of the
497 -- tree. Examples are the replacement of a generic instantiation by the
498 -- instantiated spec and body, and the static evaluation of expressions.
500 -- If such structural modifications are done by the expander, there are
501 -- no difficulties, since the form of the tree after the expander has no
502 -- special significance, except as input to the backend of the compiler.
503 -- However, if these modifications are done by the semantic phase, then
504 -- it is important that they be done in a manner which allows the original
505 -- tree to be preserved. This is because tools like pretty printers need
506 -- to have this original tree structure available.
508 -- The subprograms in this section allow rewriting of the tree by either
509 -- insertion of new nodes in an existing list, or complete replacement of
510 -- a subtree. The resulting tree for most purposes looks as though it has
511 -- been really changed, and there is no trace of the original. However,
512 -- special subprograms, also defined in this section, allow the original
513 -- tree to be reconstructed if necessary.
515 -- For tree modifications done in the expander, it is permissible to
516 -- destroy the original tree, although it is also allowable to use the
517 -- tree rewrite routines where it is convenient to do so.
519 procedure Mark_Rewrite_Insertion
(New_Node
: Node_Id
);
520 pragma Inline
(Mark_Rewrite_Insertion
);
521 -- This procedure marks the given node as an insertion made during a tree
522 -- rewriting operation. Only the root needs to be marked. The call does
523 -- not do the actual insertion, which must be done using one of the normal
524 -- list insertion routines. The node is treated normally in all respects
525 -- except for its response to Is_Rewrite_Insertion. The function of these
526 -- calls is to be able to get an accurate original tree. This helps the
527 -- accuracy of Sprint.Sprint_Node, and in particular, when stubs are being
528 -- generated, it is essential that the original tree be accurate.
530 function Is_Rewrite_Insertion
(Node
: Node_Id
) return Boolean;
531 pragma Inline
(Is_Rewrite_Insertion
);
532 -- Tests whether the given node was marked using Mark_Rewrite_Insertion.
533 -- This is used in reconstructing the original tree (where such nodes are
534 -- to be eliminated).
536 procedure Rewrite
(Old_Node
, New_Node
: Node_Id
);
537 -- This is used when a complete subtree is to be replaced. Old_Node is the
538 -- root of the old subtree to be replaced, and New_Node is the root of the
539 -- newly constructed replacement subtree. The actual mechanism is to swap
540 -- the contents of these two nodes fixing up the parent pointers of the
541 -- replaced node (we do not attempt to preserve parent pointers for the
543 -- ??? The above explanation is incorrect, instead Copy_Node is called.
545 -- Note: New_Node may not contain references to Old_Node, for example as
546 -- descendants, since the rewrite would make such references invalid. If
547 -- New_Node does need to reference Old_Node, then these references should
548 -- be to a relocated copy of Old_Node (see Relocate_Node procedure).
550 -- Note: The Original_Node function applied to Old_Node (which has now
551 -- been replaced by the contents of New_Node), can be used to obtain the
552 -- original node, i.e. the old contents of Old_Node.
554 procedure Replace
(Old_Node
, New_Node
: Node_Id
);
555 -- This is similar to Rewrite, except that the old value of Old_Node
556 -- is not saved. New_Node should not be used after Replace. The flag
557 -- Is_Rewrite_Substitution will be False for the resulting node, unless
558 -- it was already true on entry, and Original_Node will not return the
559 -- original contents of the Old_Node, but rather the New_Node value.
560 -- Replace also preserves the setting of Comes_From_Source.
562 -- Note that New_Node must not contain references to Old_Node, for example
563 -- as descendants, since the rewrite would make such references invalid. If
564 -- New_Node does need to reference Old_Node, then these references should
565 -- be to a relocated copy of Old_Node (see Relocate_Node procedure).
567 -- Replace is used in certain circumstances where it is desirable to
568 -- suppress any history of the rewriting operation. Notably, it is used
569 -- when the parser has mis-classified a node (e.g. a task entry call
570 -- that the parser has parsed as a procedure call).
572 function Is_Rewrite_Substitution
(Node
: Node_Id
) return Boolean;
573 pragma Inline
(Is_Rewrite_Substitution
);
574 -- Return True iff Node has been rewritten (i.e. if Node is the root
575 -- of a subtree which was installed using Rewrite).
577 function Original_Node
(Node
: Node_Id
) return Node_Id
;
578 pragma Inline
(Original_Node
);
579 -- If Node has not been rewritten, then returns its input argument
580 -- unchanged, else returns the Node for the original subtree. See section
581 -- in sinfo.ads for requirements on original nodes returned by this
584 -- Note: Parents are not preserved in original tree nodes that are
585 -- retrieved in this way (i.e. their children may have children whose
586 -- Parent pointers reference some other node).
588 -- Note: there is no direct mechanism for deleting an original node (in
589 -- a manner that can be reversed later). One possible approach is to use
590 -- Rewrite to substitute a null statement for the node to be deleted.
592 ----------------------
593 -- Vanishing Fields --
594 ----------------------
596 -- The Nkind and Ekind fields are like Ada discriminants governing a
597 -- variant part. They determine which fields are present. If the Nkind
598 -- or Ekind fields are changed, then this can change which fields are
599 -- present. If a field is present for the old kind, but not for the
600 -- new kind, the field vanishes. This requires some care when changing
601 -- kinds, as described below. Note that Ada doesn't even allow direct
602 -- modification of a discriminant.
604 type Node_Field_Set
is array (Node_Field
) of Boolean with Pack
;
606 type Entity_Field_Set
is array (Entity_Field
) of Boolean with Pack
;
608 procedure Reinit_Field_To_Zero
(N
: Node_Id
; Field
: Node_Or_Entity_Field
);
609 -- When a node is created, all fields are initialized to zero, even if zero
610 -- is not a valid value of the field type. This procedure puts the field
611 -- back to its initial zero value. Note that you can't just do something
612 -- like Set_Some_Field (N, 0), if Some_Field is of (say) type Uintp,
613 -- because Uintp is a subrange that does not include 0.
614 type Entity_Kind_Set
is array (Entity_Kind
) of Boolean with Pack
;
615 procedure Reinit_Field_To_Zero
616 (N
: Node_Id
; Field
: Entity_Field
; Old_Ekind
: Entity_Kind_Set
);
617 procedure Reinit_Field_To_Zero
618 (N
: Node_Id
; Field
: Entity_Field
; Old_Ekind
: Entity_Kind
);
619 -- Same as above, but assert that the old Ekind is as specified. We might
620 -- want to get rid of these, but it's useful documentation while working on
623 function Field_Is_Initial_Zero
624 (N
: Node_Id
; Field
: Node_Or_Entity_Field
) return Boolean;
625 -- True if the field value is the initial zero value
627 procedure Mutate_Nkind
(N
: Node_Id
; Val
: Node_Kind
) with Inline
;
628 -- There is no Set_Nkind in Sinfo.Nodes. We use this instead. This is here,
629 -- and has a different name, because it does some extra checking. Nkind is
630 -- like a discriminant, in that it controls which fields exist, and that
631 -- set of fields can be different for the new kind. Discriminants cannot be
632 -- modified in Ada for that reason. The rule here is more flexible: Nkind
633 -- can be modified. However, when Nkind is modified, fields that exist for
634 -- the old kind, but not for the new kind will vanish. We require that all
635 -- vanishing fields be set to their initial zero value before calling
636 -- Mutate_Nkind. This is necessary, because the memory occupied by the
637 -- vanishing fields might be used for totally unrelated fields in the new
638 -- node. See Reinit_Field_To_Zero.
640 -- It is an error to mutate a node to the same kind it already has.
642 procedure Mutate_Ekind
(N
: Entity_Id
; Val
: Entity_Kind
) with Inline
;
643 -- Ekind is also like a discriminant, and is mostly treated as above (see
646 -- It is not (yet?) an error to mutate an entity to the same kind it
647 -- already has. It is an error to mutate to E_Void.
649 function Node_To_Fetch_From
650 (N
: Node_Or_Entity_Id
; Field
: Node_Or_Entity_Field
)
651 return Node_Or_Entity_Id
is
652 (case Field_Descriptors
(Field
).Type_Only
is
653 when No_Type_Only
=> N
,
654 when Base_Type_Only
=> Base_Type
(N
),
655 when Impl_Base_Type_Only
=> Implementation_Base_Type
(N
),
656 when Root_Type_Only
=> Root_Type
(N
));
657 -- This is analogous to the same-named function in Gen_IL.Gen. Normally,
658 -- Type_Only is No_Type_Only, and we fetch the field from the node N. But
659 -- if Type_Only = Base_Type_Only, we need to go to the Base_Type, and
660 -- similarly for the other two cases. This can return something other
661 -- than N only if N is an Entity.
663 -----------------------------
664 -- Private Part Subpackage --
665 -----------------------------
667 -- The following package contains the definition of the data structure
668 -- used by the implementation of the Atree package. Logically it really
669 -- corresponds to the private part, hence the name. The reason that it
670 -- is defined as a sub-package is to allow special access from clients
671 -- that need to see the internals of the data structures.
673 package Atree_Private_Part
is
675 pragma Assert
(Node_Kind
'Pos (N_Unused_At_Start
) = 0);
676 pragma Assert
(Empty_List_Or_Node
= 0);
677 pragma Assert
(Entity_Kind
'Pos (E_Void
) = 0);
678 -- We want nodes initialized to zero bits by default
680 -------------------------
681 -- Tree Representation --
682 -------------------------
684 -- The nodes of the tree are stored in two tables (i.e. growable
687 -- A Node_Id points to an element of Node_Offsets, which contains a
688 -- Field_Offset that points to an element of Slots. Each slot can
689 -- contain a single 32-bit field, or multiple smaller fields.
690 -- An n-bit field is aligned on an n-bit boundary. The size of a node is
691 -- the number of slots, which can range from 1 up to however many are
694 -- The reason for the extra level of indirection is that Copy_Node,
695 -- Exchange_Entities, and Rewrite all assume that nodes can be modified
698 -- As an optimization, we store a few slots directly in the Node_Offsets
699 -- table (see type Node_Header) rather than requiring the extra level of
700 -- indirection for accessing those slots. N_Head is the number of slots
701 -- stored in the Node_Header. N_Head can be adjusted by modifying
702 -- Gen_IL.Gen. If N_Head is (say) 3, then a node containing 7 slots will
703 -- have slots 0..2 in the header, and 3..6 stored indirect in the Slots
704 -- table. We use zero-origin addressing, so the Offset into the Slots
705 -- table will point 3 slots before slot 3.
707 pragma Assert
(N_Head
<= Min_Node_Size
);
708 pragma Assert
(N_Head
<= Min_Entity_Size
);
710 Slot_Size
: constant := 32;
711 type Slot
is mod 2**Slot_Size
;
712 for Slot
'Size use Slot_Size
;
714 -- The type Slot is defined in Types as a 32-bit modular integer. It
715 -- is logically split into the appropriate numbers of components of
716 -- appropriate size, but this splitting is not explicit because packed
717 -- arrays cannot be properly interfaced in C/C++ and packed records are
720 type Node_Header_Slots
is
721 array (Field_Offset
range 0 .. N_Head
- 1) of Slot
;
722 type Node_Header
is record
723 Slots
: Node_Header_Slots
;
724 Offset
: Node_Offset
'Base;
726 pragma Assert
(Node_Header
'Size = (N_Head
+ 1) * Slot_Size
);
727 pragma Assert
(Node_Header
'Size = 16 * 8);
729 package Node_Offsets
is new Table
.Table
730 (Table_Component_Type
=> Node_Header
,
731 Table_Index_Type
=> Node_Id
'Base,
732 Table_Low_Bound
=> First_Node_Id
,
733 Table_Initial
=> Alloc
.Node_Offsets_Initial
,
734 Table_Increment
=> Alloc
.Node_Offsets_Increment
,
735 Table_Name
=> "Node_Offsets");
737 Noff
: Node_Offsets
.Table_Ptr
renames Node_Offsets
.Table
with
739 function Nlast
return Node_Id
'Base renames Node_Offsets
.Last
with
741 -- Short names for use in gdb, not used in real code. Note that gdb
742 -- can't find Node_Offsets.Table without a full expanded name.
744 function Shift_Left
(S
: Slot
; V
: Natural) return Slot
;
745 pragma Import
(Intrinsic
, Shift_Left
);
747 function Shift_Right
(S
: Slot
; V
: Natural) return Slot
;
748 pragma Import
(Intrinsic
, Shift_Right
);
750 -- Low-level types for fields of the various supported sizes.
751 -- All fields are a power of 2 number of bits, and are aligned
752 -- to that number of bits:
754 type Field_Size_1_Bit
is mod 2**1;
755 type Field_Size_2_Bit
is mod 2**2;
756 type Field_Size_4_Bit
is mod 2**4;
757 type Field_Size_8_Bit
is mod 2**8;
758 type Field_Size_32_Bit
is mod 2**32;
760 Slots_Low_Bound
: constant Field_Offset
:= Field_Offset
'First + 1;
762 package Slots
is new Table
.Table
763 (Table_Component_Type
=> Slot
,
764 Table_Index_Type
=> Node_Offset
'Base,
765 Table_Low_Bound
=> Slots_Low_Bound
,
766 Table_Initial
=> Alloc
.Slots_Initial
,
767 Table_Increment
=> Alloc
.Slots_Increment
,
768 Table_Name
=> "Slots");
769 -- Note that Table_Low_Bound is set such that if we try to access
770 -- Slots.Table (0), we will get Constraint_Error.
772 Slts
: Slots
.Table_Ptr
renames Slots
.Table
with
774 function Slast
return Node_Offset
'Base renames Slots
.Last
with
776 -- Short names for use in gdb, not used in real code. Note that gdb
777 -- can't find Slots.Table without a full expanded name.
779 function Alloc_Node_Id
return Node_Id
with Inline
;
781 function Alloc_Slots
(Num_Slots
: Slot_Count
) return Node_Offset
783 -- Allocate the slots for a node in the Slots table
785 -- Each of the following Get_N_Bit_Field functions fetches the field of
786 -- the given Field_Type at the given offset. Field_Type'Size must be N.
787 -- The offset is measured in units of Field_Type'Size. Likewise for the
788 -- Set_N_Bit_Field procedures. These are instantiated in Sinfo.Nodes and
789 -- Einfo.Entities for the various possible Field_Types (Flag, Node_Id,
793 type Field_Type
is private;
794 function Get_1_Bit_Field
795 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
799 type Field_Type
is private;
800 function Get_2_Bit_Field
801 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
805 type Field_Type
is private;
806 function Get_4_Bit_Field
807 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
811 type Field_Type
is private;
812 function Get_8_Bit_Field
813 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
817 type Field_Type
is private;
818 function Get_32_Bit_Field
819 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
823 type Field_Type
is private;
824 Default_Val
: Field_Type
;
825 function Get_32_Bit_Field_With_Default
826 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
828 -- If the field has not yet been set, return Default_Val
831 type Field_Type
is private;
832 function Get_Valid_32_Bit_Field
833 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Type
835 -- Assert that the field has already been set. This is currently used
836 -- only for Uints, but could be used more generally.
839 type Field_Type
is private;
840 procedure Set_1_Bit_Field
841 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Type
)
845 type Field_Type
is private;
846 procedure Set_2_Bit_Field
847 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Type
)
851 type Field_Type
is private;
852 procedure Set_4_Bit_Field
853 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Type
)
857 type Field_Type
is private;
858 procedure Set_8_Bit_Field
859 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Type
)
863 type Field_Type
is private;
864 procedure Set_32_Bit_Field
865 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Type
)
868 -- The following are similar to the above generics, but are not generic,
869 -- and work with the low-level Field_n_bit types. If generics could be
870 -- overloaded, we would use the same names.
872 function Get_1_Bit_Val
873 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Size_1_Bit
876 function Get_2_Bit_Val
877 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Size_2_Bit
880 function Get_4_Bit_Val
881 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Size_4_Bit
884 function Get_8_Bit_Val
885 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Size_8_Bit
888 function Get_32_Bit_Val
889 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
) return Field_Size_32_Bit
892 procedure Set_1_Bit_Val
893 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Size_1_Bit
)
896 procedure Set_2_Bit_Val
897 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Size_2_Bit
)
900 procedure Set_4_Bit_Val
901 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Size_4_Bit
)
904 procedure Set_8_Bit_Val
905 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Size_8_Bit
)
908 procedure Set_32_Bit_Val
909 (N
: Node_Or_Entity_Id
; Offset
: Field_Offset
; Val
: Field_Size_32_Bit
)
912 -- The following are used in "asserts on" mode to validate nodes; an
913 -- exception is raised if invalid node content is detected.
915 procedure Validate_Node
(N
: Node_Or_Entity_Id
);
916 -- Validate for reading
917 procedure Validate_Node_Write
(N
: Node_Or_Entity_Id
);
918 -- Validate for writing
920 function Is_Valid_Node
(U
: Union_Id
) return Boolean;
921 -- True if U is within the range of Node_Offsets
923 procedure Print_Atree_Info
(N
: Node_Or_Entity_Id
);
924 -- Called from Treepr to print out information about N that is private
927 end Atree_Private_Part
;
931 subtype Call_Count
is Nat_64
;
932 Get_Count
, Set_Count
: array (Node_Or_Entity_Field
) of Call_Count
:=
934 -- Number of calls to each getter and setter. See documentaton for
937 Get_Original_Node_Count
, Set_Original_Node_Count
: Call_Count
:= 0;
939 procedure Print_Statistics
;