1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- S I N F O . U T I L S --
9 -- Copyright (C) 2020-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 with Sinfo
.Nodes
; use Sinfo
.Nodes
;
28 package Sinfo
.Utils
is
30 -------------------------------
31 -- Parent-related operations --
32 -------------------------------
34 procedure Copy_Parent
(To
, From
: Node_Or_Entity_Id
);
35 -- Does Set_Parent (To, Parent (From)), except that if To or From are
36 -- empty, does nothing. If From is empty but To is not, then Parent (To)
37 -- should already be Empty.
39 function Parent_Kind
(N
: Node_Id
) return Node_Kind
;
40 -- Same as Nkind (Parent (N)), except if N is Empty, return N_Empty
42 -------------------------
43 -- Iterator Procedures --
44 -------------------------
46 -- The call to Next_xxx (N) is equivalent to N := Next_xxx (N)
48 procedure Next_Entity
(N
: in out Node_Id
);
49 procedure Next_Named_Actual
(N
: in out Node_Id
);
50 procedure Next_Rep_Item
(N
: in out Node_Id
);
51 procedure Next_Use_Clause
(N
: in out Node_Id
);
53 -------------------------------------------
54 -- Miscellaneous Tree Access Subprograms --
55 -------------------------------------------
57 function First_Real_Statement
-- ????
58 (Ignored
: N_Handled_Sequence_Of_Statements_Id
) return Node_Id
is (Empty
);
59 -- The First_Real_Statement field is going away, but it is referenced in
60 -- codepeer and gnat-llvm. This is a temporary version, always returning
61 -- Empty, to ease the transition.
63 function End_Location
(N
: Node_Id
) return Source_Ptr
;
64 -- N is an N_If_Statement or N_Case_Statement node, and this function
65 -- returns the location of the IF token in the END IF sequence by
66 -- translating the value of the End_Span field.
68 -- WARNING: There is a matching C declaration of this subprogram in fe.h
70 procedure Set_End_Location
(N
: Node_Id
; S
: Source_Ptr
);
71 -- N is an N_If_Statement or N_Case_Statement node. This procedure sets
72 -- the End_Span field to correspond to the given value S. In other words,
73 -- End_Span is set to the difference between S and Sloc (N), the starting
76 function Get_Pragma_Arg
(Arg
: Node_Id
) return Node_Id
;
77 -- Given an argument to a pragma Arg, this function returns the expression
78 -- for the argument. This is Arg itself, or, in the case where Arg is a
79 -- pragma argument association node, the expression from this node.
81 -----------------------
82 -- Utility Functions --
83 -----------------------
85 procedure Map_Pragma_Name
(From
, To
: Name_Id
);
86 -- Used in the implementation of pragma Rename_Pragma. Maps pragma name
87 -- From to pragma name To, so From can be used as a synonym for To.
89 Too_Many_Pragma_Mappings
: exception;
90 -- Raised if Map_Pragma_Name is called too many times. We expect that few
91 -- programs will use it at all, and those that do will use it approximately
94 function Pragma_Name
(N
: Node_Id
) return Name_Id
;
95 -- Obtain the name of pragma N from the Chars field of its identifier. If
96 -- the pragma has been renamed using Rename_Pragma, this routine returns
97 -- the name of the renaming.
99 function Pragma_Name_Unmapped
(N
: Node_Id
) return Name_Id
;
100 -- Obtain the name of pragma N from the Chars field of its identifier. This
101 -- form of name extraction does not take into account renamings performed
105 with procedure Action
(U
: Union_Id
);
106 procedure Walk_Sinfo_Fields
(N
: Node_Id
);
107 -- Walk the Sinfo fields of N, for all field types that Union_Id includes,
108 -- and call Action on each one. However, skip the Link field, which is the
109 -- Parent, and would cause us to wander off into the weeds.
112 with function Transform
(U
: Union_Id
) return Union_Id
;
113 procedure Walk_Sinfo_Fields_Pairwise
(N1
, N2
: Node_Id
);
114 -- Walks the Sinfo fields of N1 and N2 pairwise, calls Tranform on each N2
115 -- field, copying the resut into the corresponding field of N1. The Nkinds
116 -- must match. Link is skipped.
118 -------------------------------------------
119 -- Aliases for Entity_Or_Associated_Node --
120 -------------------------------------------
122 -- Historically, the Entity, Associated_Node, and Entity_Or_Associated_Node
123 -- fields shared the same slot. A further complication is that there is an
124 -- N_Has_Entity that does not include all node types that have the Entity
125 -- field. N_Inclusive_Has_Entity are the node types that have the Entity
128 subtype N_Inclusive_Has_Entity
is Node_Id
with Predicate
=>
129 N_Inclusive_Has_Entity
in
131 | N_Attribute_Definition_Clause_Id
132 | N_Aspect_Specification_Id
134 | N_Freeze_Generic_Entity_Id
;
136 subtype N_Has_Associated_Node
is Node_Id
with Predicate
=>
137 N_Has_Associated_Node
in
140 | N_Extension_Aggregate_Id
141 | N_Selected_Component_Id
142 | N_Use_Package_Clause_Id
;
144 function Associated_Node
145 (N
: N_Has_Associated_Node
) return Node_Id
146 renames Entity_Or_Associated_Node
;
149 (N
: N_Inclusive_Has_Entity
) return Node_Id
150 renames Entity_Or_Associated_Node
;
152 procedure Set_Associated_Node
153 (N
: N_Has_Associated_Node
; Val
: Node_Id
)
154 renames Set_Entity_Or_Associated_Node
;
157 (N
: N_Inclusive_Has_Entity
; Val
: Node_Id
)
158 renames Set_Entity_Or_Associated_Node
;
164 procedure New_Node_Debugging_Output
(N
: Node_Id
);
165 pragma Inline
(New_Node_Debugging_Output
);
166 -- See package body for documentation