1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2000, Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 -- This package contains various utility procedures to assist in
30 -- building specific types of tree nodes.
32 with Types
; use Types
;
36 function Make_DT_Component
41 -- Gives a reference to the Ith component of the Dispatch Table of
42 -- a given Tagged Type.
44 -- I = 1 --> Inheritance_Depth
45 -- I = 2 --> Tags (array of ancestors)
46 -- I = 3, 4 --> predefined primitive
47 -- function _Size (X : Typ) return Long_Long_Integer;
48 -- function _Equality (X : Typ; Y : Typ'Class) return Boolean;
49 -- I >= 5 --> User-Defined Primitive Operations
51 function Make_DT_Access
52 (Loc
: Source_Ptr
; Rec
: Node_Id
; Typ
: Entity_Id
) return Node_Id
;
53 -- Create an access to the Dispatch Table by using the Tag field
54 -- of a tagged record : Acc_Dt (Rec.tag).all
56 function Make_Implicit_If_Statement
59 Then_Statements
: List_Id
;
60 Elsif_Parts
: List_Id
:= No_List
;
61 Else_Statements
: List_Id
:= No_List
)
63 pragma Inline
(Make_Implicit_If_Statement
);
64 -- This function makes an N_If_Statement node whose fields are filled
65 -- in with the indicated values (see Sinfo), and whose Sloc field is
66 -- is set to Sloc (Node). The effect is identical to calling function
67 -- Nmake.Make_If_Statement except that there is a check for restriction
68 -- No_Implicit_Conditionals, and if this restriction is being violated,
69 -- an error message is posted on Node.
71 function Make_Implicit_Label_Declaration
73 Defining_Identifier
: Node_Id
;
74 Label_Construct
: Node_Id
)
76 -- Used to contruct an implicit label declaration node, including setting
77 -- the proper Label_Construct field (since Label_Construct is a semantic
78 -- field, the normal call to Make_Implicit_Label_Declaration does not
81 function Make_Implicit_Loop_Statement
84 Identifier
: Node_Id
:= Empty
;
85 Iteration_Scheme
: Node_Id
:= Empty
;
86 Has_Created_Identifier
: Boolean := False;
87 End_Label
: Node_Id
:= Empty
)
89 -- This function makes an N_Loop_Statement node whose fields are filled
90 -- in with the indicated values (see Sinfo), and whose Sloc field is
91 -- is set to Sloc (Node). The effect is identical to calling function
92 -- Nmake.Make_Loop_Statement except that there is a check for restrictions
93 -- No_Implicit_Loops and No_Implicit_Conditionals (the first applying in
94 -- all cases, and the second only for while loops), and if one of these
95 -- restrictions is being violated, an error message is posted on Node.
97 function Make_Integer_Literal
101 pragma Inline
(Make_Integer_Literal
);
102 -- A convenient form of Make_Integer_Literal taking Int instead of Uint
104 function Make_Unsuppress_Block
109 -- Build a block with a pragma Suppress on 'Check'. Stmts is the
110 -- statements list that needs protection against the check
112 function New_Constraint_Error
(Loc
: Source_Ptr
) return Node_Id
;
113 -- This function builds a tree corresponding to the Ada statement
114 -- "raise Constraint_Error" and returns the root of this tree,
115 -- the N_Raise_Statement node.
117 function New_External_Name
118 (Related_Id
: Name_Id
;
119 Suffix
: Character := ' ';
120 Suffix_Index
: Int
:= 0;
121 Prefix
: Character := ' ')
123 function New_External_Name
124 (Related_Id
: Name_Id
;
126 Suffix_Index
: Int
:= 0;
127 Prefix
: Character := ' ')
129 -- Builds a new entry in the names table of the form:
131 -- [Prefix &] Related_Id [& Suffix] [& Suffix_Index]
133 -- Prefix is prepended only if Prefix is non-blank (in which case it
134 -- must be an upper case letter other than O,Q,U,W (which are used for
135 -- identifier encoding, see Namet), and T is reserved for use by implicit
136 -- types. and X is reserved for use by debug type encoding (see package
137 -- Exp_Dbug). Note: the reason that Prefix is last is that it is almost
138 -- always omitted. The notable case of Prefix being non-null is when
139 -- it is 'T' for an implicit type.
141 -- Suffix_Index'Image is appended only if the value of Suffix_Index is
142 -- positive, or if Suffix_Index is negative 1, then a unique serialized
143 -- suffix is added. If Suffix_Index is zero, then no index is appended.
145 -- Suffix is also a single upper case letter other than O,Q,U,W,X and is a
146 -- required parameter (T is permitted). The constructed name is stored
147 -- using Find_Name so that it can be located using a subsequent Find_Name
148 -- operation (i.e. it is properly hashed into the names table). The upper
149 -- case letter given as the Suffix argument ensures that the name does
150 -- not clash with any Ada identifier name. These generated names are
151 -- permitted, but not required, to be made public by setting the flag
152 -- Is_Public in the associated entity.
154 function New_External_Name
158 -- Builds a new entry in the names table of the form
159 -- Suffix & Suffix_Index'Image
160 -- where Suffix is a single upper case letter other than O,Q,U,W,X and is
161 -- a required parameter (T is permitted). The constructed name is stored
162 -- using Find_Name so that it can be located using a subsequent Find_Name
163 -- operation (i.e. it is properly hashed into the names table). The upper
164 -- case letter given as the Suffix argument ensures that the name does
165 -- not clash with any Ada identifier name. These generated names are
166 -- permitted, but not required, to be made public by setting the flag
167 -- Is_Public in the associated entity.
169 function New_Internal_Name
(Id_Char
: Character) return Name_Id
;
170 -- Id_Char is an upper case letter other than O,Q,U,W (which are reserved
171 -- for identifier encoding (see Namet package for details) and X which is
172 -- used for debug encoding (see Exp_Dbug). The letter T is permitted, but
173 -- is reserved by convention for the case of internally generated types.
174 -- The result of the call is a new generated unique name of the form XyyyU
175 -- where X is Id_Char, yyy is a unique serial number, and U is either a
176 -- lower case s or b indicating if the current unit is a spec or a body.
178 -- The name is entered into the names table using Name_Enter rather than
179 -- Name_Find, because there can never be a need to locate the entry using
180 -- the Name_Find procedure later on. Names created by New_Internal_Name
181 -- are guaranteed to be consistent from one compilation to another (i.e.
182 -- if the identical unit is compiled with a semantically consistent set
183 -- of sources, the numbers will be consistent. This means that it is fine
184 -- to use these as public symbols.
186 function New_Suffixed_Name
187 (Related_Id
: Name_Id
;
190 -- This function is used to create special suffixed names used by the
191 -- debugger. Suffix is a string of upper case letters, used to construct
192 -- the required name. For instance, the special type used to record the
193 -- fixed-point small is called typ_SMALL where typ is the name of the
194 -- fixed-point type (as passed in Related_Id), and Suffix is "SMALL".
196 function New_Occurrence_Of
200 -- New_Occurrence_Of creates an N_Identifier node which is an
201 -- occurrence of the defining identifier which is passed as its
202 -- argument. The Entity and Etype of the result are set from
203 -- the given defining identifier as follows: Entity is simply
204 -- a copy of Def_Id. Etype is a copy of Def_Id for types, and
205 -- a copy of the Etype of Def_Id for other entities.
207 function New_Reference_To
211 -- This is like New_Occurrence_Of, but it does not set the Etype field.
212 -- It is used from the expander, where Etype fields are generally not set,
213 -- since they are set when the expanded tree is reanalyzed.
215 function Checks_Off
(N
: Node_Id
) return Node_Id
;
216 pragma Inline
(Checks_Off
);
217 -- Returns an N_Unchecked_Expression node whose expression is the given
218 -- argument. The results is a subexpression identical to the argument,
219 -- except that it will be analyzed and resolved with checks off.
221 function Convert_To
(Typ
: Entity_Id
; Expr
: Node_Id
) return Node_Id
;
222 -- Returns an expression that represents the result of a checked convert
223 -- of expression Exp to type T. If the base type of Exp is T, then no
224 -- conversion is required, and Exp is returned unchanged. Otherwise an
225 -- N_Type_Conversion node is constructed to convert the expression.
226 -- If an N_Type_Conversion node is required, Relocate_Node is used on
227 -- Exp. This means that it is safe to replace a node by a Convert_To
228 -- of itself to some other type.
230 function OK_Convert_To
(Typ
: Entity_Id
; Expr
: Node_Id
) return Node_Id
;
231 -- Like Convert_To, except that a conversion node is always generated,
232 -- and the Conversion_OK flag is set on this conversion node.
234 function Unchecked_Convert_To
238 -- Like Convert_To, but if a conversion is actually needed, constructs
239 -- an N_Unchecked_Type_Conversion node to do the required conversion.