aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sinfo-utils.ads
blob: 9acb620848cc361dcdf0f568777b1671d15d7baa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                           S I N F O . U T I L S                          --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--           Copyright (C) 2020-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.      --
--                                                                          --
------------------------------------------------------------------------------

with Sinfo.Nodes; use Sinfo.Nodes;

package Sinfo.Utils is

   -------------------------------
   -- Parent-related operations --
   -------------------------------

   procedure Copy_Parent (To, From : Node_Or_Entity_Id);
   --  Does Set_Parent (To, Parent (From)), except that if To or From are
   --  empty, does nothing. If From is empty but To is not, then Parent (To)
   --  should already be Empty.

   function Parent_Kind (N : Node_Id) return Node_Kind;
   --  Same as Nkind (Parent (N)), except if N is Empty, return N_Empty

   -------------------------
   -- Iterator Procedures --
   -------------------------

   --  The call to Next_xxx (N) is equivalent to N := Next_xxx (N)

   procedure Next_Entity       (N : in out Node_Id);
   procedure Next_Named_Actual (N : in out Node_Id);
   procedure Next_Rep_Item     (N : in out Node_Id);
   procedure Next_Use_Clause   (N : in out Node_Id);

   -------------------------------------------
   -- Miscellaneous Tree Access Subprograms --
   -------------------------------------------

   function First_Real_Statement -- ????
     (Ignored : N_Handled_Sequence_Of_Statements_Id) return Node_Id is (Empty);
   --  The First_Real_Statement field is going away, but it is referenced in
   --  codepeer and gnat-llvm. This is a temporary version, always returning
   --  Empty, to ease the transition.

   function End_Location (N : Node_Id) return Source_Ptr;
   --  N is an N_If_Statement or N_Case_Statement node, and this function
   --  returns the location of the IF token in the END IF sequence by
   --  translating the value of the End_Span field.

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

   procedure Set_End_Location (N : Node_Id; S : Source_Ptr);
   --  N is an N_If_Statement or N_Case_Statement node. This procedure sets
   --  the End_Span field to correspond to the given value S. In other words,
   --  End_Span is set to the difference between S and Sloc (N), the starting
   --  location.

   function Get_Pragma_Arg (Arg : Node_Id) return Node_Id;
   --  Given an argument to a pragma Arg, this function returns the expression
   --  for the argument. This is Arg itself, or, in the case where Arg is a
   --  pragma argument association node, the expression from this node.

   -----------------------
   -- Utility Functions --
   -----------------------

   procedure Map_Pragma_Name (From, To : Name_Id);
   --  Used in the implementation of pragma Rename_Pragma. Maps pragma name
   --  From to pragma name To, so From can be used as a synonym for To.

   Too_Many_Pragma_Mappings : exception;
   --  Raised if Map_Pragma_Name is called too many times. We expect that few
   --  programs will use it at all, and those that do will use it approximately
   --  once or twice.

   function Pragma_Name (N : Node_Id) return Name_Id;
   --  Obtain the name of pragma N from the Chars field of its identifier. If
   --  the pragma has been renamed using Rename_Pragma, this routine returns
   --  the name of the renaming.

   function Pragma_Name_Unmapped (N : Node_Id) return Name_Id;
   --  Obtain the name of pragma N from the Chars field of its identifier. This
   --  form of name extraction does not take into account renamings performed
   --  by Rename_Pragma.

   generic
      with procedure Action (U : Union_Id);
   procedure Walk_Sinfo_Fields (N : Node_Id);
   --  Walk the Sinfo fields of N, for all field types that Union_Id includes,
   --  and call Action on each one. However, skip the Link field, which is the
   --  Parent, and would cause us to wander off into the weeds.

   generic
      with function Transform (U : Union_Id) return Union_Id;
   procedure Walk_Sinfo_Fields_Pairwise (N1, N2 : Node_Id);
   --  Walks the Sinfo fields of N1 and N2 pairwise, calls Tranform on each N2
   --  field, copying the resut into the corresponding field of N1. The Nkinds
   --  must match. Link is skipped.

   -------------------------------------------
   -- Aliases for Entity_Or_Associated_Node --
   -------------------------------------------

   --  Historically, the Entity, Associated_Node, and Entity_Or_Associated_Node
   --  fields shared the same slot. A further complication is that there is an
   --  N_Has_Entity that does not include all node types that have the Entity
   --  field. N_Inclusive_Has_Entity are the node types that have the Entity
   --  field.

   subtype N_Inclusive_Has_Entity is Node_Id with Predicate =>
     N_Inclusive_Has_Entity in
       N_Has_Entity_Id
       | N_Attribute_Definition_Clause_Id
       | N_Aspect_Specification_Id
       | N_Freeze_Entity_Id
       | N_Freeze_Generic_Entity_Id;

   subtype N_Has_Associated_Node is Node_Id with Predicate =>
     N_Has_Associated_Node in
       N_Has_Entity_Id
       | N_Aggregate_Id
       | N_Extension_Aggregate_Id
       | N_Selected_Component_Id
       | N_Use_Package_Clause_Id;

   function Associated_Node
     (N : N_Has_Associated_Node) return Node_Id
      renames Entity_Or_Associated_Node;

   function Entity
     (N : N_Inclusive_Has_Entity) return Node_Id
      renames Entity_Or_Associated_Node;

   procedure Set_Associated_Node
     (N : N_Has_Associated_Node; Val : Node_Id)
      renames Set_Entity_Or_Associated_Node;

   procedure Set_Entity
     (N : N_Inclusive_Has_Entity; Val : Node_Id)
      renames Set_Entity_Or_Associated_Node;

   ---------------------------------------------------
   -- Aliases for Aggregate_Bounds_Or_Ancestor_Type --
   ---------------------------------------------------

   function Aggregate_Bounds (N : Node_Id) return Node_Id
      renames Aggregate_Bounds_Or_Ancestor_Type;

   function Ancestor_Type (N : Node_Id) return Node_Id
      renames Aggregate_Bounds_Or_Ancestor_Type;

   procedure Set_Aggregate_Bounds (N : Node_Id; Val : Node_Id)
      renames Set_Aggregate_Bounds_Or_Ancestor_Type;

   procedure Set_Ancestor_Type (N : Node_Id; Val : Node_Id)
      renames Set_Aggregate_Bounds_Or_Ancestor_Type;

   ---------------
   -- Debugging --
   ---------------

   procedure New_Node_Debugging_Output (N : Node_Id);
   pragma Inline (New_Node_Debugging_Output);
   --  See package body for documentation

end Sinfo.Utils;