]>
Commit | Line | Data |
---|---|---|
1f41ed06 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P P R I N T -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
3ddfabe3 | 9 | -- Copyright (C) 2008-2016, Free Software Foundation, Inc. -- |
1f41ed06 AC |
10 | -- -- |
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. -- | |
20 | -- -- | |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
23 | -- -- | |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | with Atree; use Atree; | |
27 | with Einfo; use Einfo; | |
28 | with Namet; use Namet; | |
29 | with Nlists; use Nlists; | |
30 | with Opt; use Opt; | |
31 | with Sinfo; use Sinfo; | |
32 | with Sinput; use Sinput; | |
33 | with Snames; use Snames; | |
34 | with Uintp; use Uintp; | |
35 | ||
36 | package body Pprint is | |
37 | ||
38 | List_Name_Count : Integer := 0; | |
39 | -- Counter used to prevent infinite recursion while computing name of | |
40 | -- complex expressions. | |
41 | ||
42 | ---------------------- | |
43 | -- Expression_Image -- | |
44 | ---------------------- | |
45 | ||
78cef47f AC |
46 | function Expression_Image |
47 | (Expr : Node_Id; | |
48 | Default : String) return String | |
49 | is | |
1f41ed06 | 50 | From_Source : constant Boolean := |
78cef47f AC |
51 | Comes_From_Source (Expr) |
52 | and then not Opt.Debug_Generated_Code; | |
1f41ed06 | 53 | Append_Paren : Boolean := False; |
78cef47f AC |
54 | Left : Node_Id := Original_Node (Expr); |
55 | Right : Node_Id := Original_Node (Expr); | |
1f41ed06 AC |
56 | |
57 | function Expr_Name | |
58 | (Expr : Node_Id; | |
59 | Take_Prefix : Boolean := True; | |
60 | Expand_Type : Boolean := True) return String; | |
61 | -- Return string corresponding to Expr. If no string can be extracted, | |
62 | -- return "...". If Take_Prefix is True, go back to prefix when needed, | |
63 | -- otherwise only consider the right-hand side of an expression. If | |
64 | -- Expand_Type is True and Expr is a type, try to expand Expr (an | |
65 | -- internally generated type) into a user understandable name. | |
66 | ||
67 | Max_List : constant := 3; | |
68 | -- Limit number of list elements to dump | |
69 | ||
70 | Max_Expr_Elements : constant := 24; | |
71 | -- Limit number of elements in an expression for use by Expr_Name | |
72 | ||
73 | Num_Elements : Natural := 0; | |
74 | -- Current number of elements processed by Expr_Name | |
75 | ||
76 | function List_Name | |
77 | (List : Node_Id; | |
78 | Add_Space : Boolean := True; | |
79 | Add_Paren : Boolean := True) return String; | |
80 | -- Return a string corresponding to List | |
81 | ||
78cef47f AC |
82 | --------------- |
83 | -- List_Name -- | |
84 | --------------- | |
85 | ||
1f41ed06 AC |
86 | function List_Name |
87 | (List : Node_Id; | |
88 | Add_Space : Boolean := True; | |
89 | Add_Paren : Boolean := True) return String | |
90 | is | |
91 | function Internal_List_Name | |
92 | (List : Node_Id; | |
93 | First : Boolean := True; | |
94 | Add_Space : Boolean := True; | |
95 | Add_Paren : Boolean := True; | |
96 | Num : Natural := 1) return String; | |
78cef47f | 97 | -- ??? what does this do |
1f41ed06 AC |
98 | |
99 | ------------------------ | |
100 | -- Internal_List_Name -- | |
101 | ------------------------ | |
102 | ||
103 | function Internal_List_Name | |
104 | (List : Node_Id; | |
105 | First : Boolean := True; | |
106 | Add_Space : Boolean := True; | |
107 | Add_Paren : Boolean := True; | |
108 | Num : Natural := 1) return String | |
109 | is | |
110 | function Prepend (S : String) return String; | |
78cef47f | 111 | -- ??? what does this do |
1f41ed06 AC |
112 | |
113 | ------------- | |
114 | -- Prepend -- | |
115 | ------------- | |
116 | ||
117 | function Prepend (S : String) return String is | |
118 | begin | |
119 | if Add_Space then | |
120 | if Add_Paren then | |
121 | return " (" & S; | |
122 | else | |
123 | return ' ' & S; | |
124 | end if; | |
125 | elsif Add_Paren then | |
126 | return '(' & S; | |
127 | else | |
128 | return S; | |
129 | end if; | |
130 | end Prepend; | |
131 | ||
132 | -- Start of processing for Internal_List_Name | |
133 | ||
134 | begin | |
135 | if not Present (List) then | |
136 | if First or else not Add_Paren then | |
137 | return ""; | |
138 | else | |
139 | return ")"; | |
140 | end if; | |
141 | elsif Num > Max_List then | |
142 | if Add_Paren then | |
143 | return ", ...)"; | |
144 | else | |
145 | return ", ..."; | |
146 | end if; | |
147 | end if; | |
148 | ||
78cef47f AC |
149 | -- ??? the Internal_List_Name calls can be factored out |
150 | ||
1f41ed06 | 151 | if First then |
78cef47f AC |
152 | return Prepend (Expr_Name (List) |
153 | & Internal_List_Name | |
154 | (List => Next (List), | |
155 | First => False, | |
156 | Add_Paren => Add_Paren, | |
157 | Num => Num + 1)); | |
1f41ed06 | 158 | else |
78cef47f AC |
159 | return ", " & Expr_Name (List) |
160 | & Internal_List_Name | |
161 | (List => Next (List), | |
162 | First => False, | |
163 | Add_Paren => Add_Paren, | |
164 | Num => Num + 1); | |
1f41ed06 AC |
165 | end if; |
166 | end Internal_List_Name; | |
167 | ||
168 | -- Start of processing for List_Name | |
169 | ||
170 | begin | |
171 | -- Prevent infinite recursion by limiting depth to 3 | |
172 | ||
173 | if List_Name_Count > 3 then | |
174 | return "..."; | |
175 | end if; | |
176 | ||
177 | List_Name_Count := List_Name_Count + 1; | |
78cef47f | 178 | |
1f41ed06 AC |
179 | declare |
180 | Result : constant String := | |
78cef47f AC |
181 | Internal_List_Name |
182 | (List => List, | |
183 | Add_Space => Add_Space, | |
184 | Add_Paren => Add_Paren); | |
1f41ed06 AC |
185 | begin |
186 | List_Name_Count := List_Name_Count - 1; | |
187 | return Result; | |
188 | end; | |
189 | end List_Name; | |
190 | ||
191 | --------------- | |
192 | -- Expr_Name -- | |
193 | --------------- | |
194 | ||
195 | function Expr_Name | |
196 | (Expr : Node_Id; | |
197 | Take_Prefix : Boolean := True; | |
198 | Expand_Type : Boolean := True) return String | |
199 | is | |
200 | begin | |
201 | Num_Elements := Num_Elements + 1; | |
202 | ||
203 | if Num_Elements > Max_Expr_Elements then | |
204 | return "..."; | |
205 | end if; | |
206 | ||
207 | case Nkind (Expr) is | |
208 | when N_Defining_Identifier | N_Identifier => | |
209 | return Ident_Image (Expr, Expression_Image.Expr, Expand_Type); | |
210 | ||
211 | when N_Character_Literal => | |
212 | declare | |
213 | Char : constant Int := | |
78cef47f | 214 | UI_To_Int (Char_Literal_Value (Expr)); |
1f41ed06 AC |
215 | begin |
216 | if Char in 32 .. 127 then | |
217 | return "'" & Character'Val (Char) & "'"; | |
218 | else | |
219 | UI_Image (Char_Literal_Value (Expr)); | |
78cef47f AC |
220 | return |
221 | "'\" & UI_Image_Buffer (1 .. UI_Image_Length) & "'"; | |
1f41ed06 AC |
222 | end if; |
223 | end; | |
224 | ||
225 | when N_Integer_Literal => | |
226 | UI_Image (Intval (Expr)); | |
227 | return UI_Image_Buffer (1 .. UI_Image_Length); | |
228 | ||
229 | when N_Real_Literal => | |
230 | return Real_Image (Realval (Expr)); | |
231 | ||
232 | when N_String_Literal => | |
233 | return String_Image (Strval (Expr)); | |
234 | ||
235 | when N_Allocator => | |
236 | return "new " & Expr_Name (Expression (Expr)); | |
237 | ||
238 | when N_Aggregate => | |
239 | if Present (Sinfo.Expressions (Expr)) then | |
78cef47f AC |
240 | return |
241 | List_Name | |
242 | (List => First (Sinfo.Expressions (Expr)), | |
243 | Add_Space => False); | |
1f41ed06 | 244 | |
a905304c AC |
245 | -- Do not return empty string for (others => <>) aggregate |
246 | -- of a componentless record type. At least one caller (the | |
247 | -- recursive call below in the N_Qualified_Expression case) | |
248 | -- is not prepared to deal with a zero-length result. | |
249 | ||
250 | elsif Null_Record_Present (Expr) | |
251 | or else not Present (First (Component_Associations (Expr))) | |
252 | then | |
1f41ed06 AC |
253 | return ("(null record)"); |
254 | ||
255 | else | |
78cef47f AC |
256 | return |
257 | List_Name | |
258 | (List => First (Component_Associations (Expr)), | |
259 | Add_Space => False, | |
260 | Add_Paren => False); | |
1f41ed06 AC |
261 | end if; |
262 | ||
263 | when N_Extension_Aggregate => | |
78cef47f AC |
264 | return "(" & Expr_Name (Ancestor_Part (Expr)) & " with " |
265 | & List_Name | |
266 | (List => First (Sinfo.Expressions (Expr)), | |
267 | Add_Space => False, | |
268 | Add_Paren => False) & ")"; | |
1f41ed06 AC |
269 | |
270 | when N_Attribute_Reference => | |
271 | if Take_Prefix then | |
272 | declare | |
1f41ed06 | 273 | Id : constant Attribute_Id := |
78cef47f AC |
274 | Get_Attribute_Id (Attribute_Name (Expr)); |
275 | Str : constant String := | |
276 | Expr_Name (Prefix (Expr)) & "'" | |
277 | & Get_Name_String (Attribute_Name (Expr)); | |
1f41ed06 | 278 | N : Node_Id; |
78cef47f | 279 | Ranges : List_Id; |
1f41ed06 AC |
280 | |
281 | begin | |
282 | if (Id = Attribute_First or else Id = Attribute_Last) | |
283 | and then Str (Str'First) = '$' | |
284 | then | |
285 | N := Associated_Node_For_Itype (Etype (Prefix (Expr))); | |
286 | ||
287 | if Present (N) then | |
288 | if Nkind (N) = N_Full_Type_Declaration then | |
289 | N := Type_Definition (N); | |
290 | end if; | |
291 | ||
292 | if Nkind (N) = N_Subtype_Declaration then | |
78cef47f AC |
293 | Ranges := |
294 | Constraints | |
295 | (Constraint (Subtype_Indication (N))); | |
1f41ed06 AC |
296 | |
297 | if List_Length (Ranges) = 1 | |
78cef47f AC |
298 | and then |
299 | Nkind_In | |
300 | (First (Ranges), | |
301 | N_Range, | |
302 | N_Real_Range_Specification, | |
303 | N_Signed_Integer_Type_Definition) | |
1f41ed06 AC |
304 | then |
305 | if Id = Attribute_First then | |
78cef47f AC |
306 | return |
307 | Expression_Image | |
308 | (Low_Bound (First (Ranges)), Str); | |
1f41ed06 | 309 | else |
78cef47f AC |
310 | return |
311 | Expression_Image | |
312 | (High_Bound (First (Ranges)), Str); | |
1f41ed06 AC |
313 | end if; |
314 | end if; | |
315 | end if; | |
316 | end if; | |
317 | end if; | |
318 | ||
319 | return Str; | |
320 | end; | |
321 | else | |
322 | return "'" & Get_Name_String (Attribute_Name (Expr)); | |
323 | end if; | |
324 | ||
325 | when N_Explicit_Dereference => | |
78cef47f AC |
326 | |
327 | -- Return "Foo" instead of "Parameter_Block.Foo.all" | |
328 | ||
329 | if Hide_Parameter_Blocks | |
330 | and then Nkind (Prefix (Expr)) = N_Selected_Component | |
331 | and then Present (Etype (Prefix (Expr))) | |
332 | and then Is_Access_Type (Etype (Prefix (Expr))) | |
333 | and then Is_Param_Block_Component_Type (Etype (Prefix (Expr))) | |
334 | then | |
335 | return Expr_Name (Selector_Name (Prefix (Expr))); | |
336 | ||
337 | elsif Take_Prefix then | |
1f41ed06 AC |
338 | return Expr_Name (Prefix (Expr)) & ".all"; |
339 | else | |
340 | return ".all"; | |
341 | end if; | |
342 | ||
343 | when N_Expanded_Name | N_Selected_Component => | |
344 | if Take_Prefix then | |
78cef47f AC |
345 | return |
346 | Expr_Name (Prefix (Expr)) & "." & | |
347 | Expr_Name (Selector_Name (Expr)); | |
1f41ed06 AC |
348 | else |
349 | return "." & Expr_Name (Selector_Name (Expr)); | |
350 | end if; | |
351 | ||
352 | when N_Component_Association => | |
353 | return "(" | |
78cef47f AC |
354 | & List_Name |
355 | (List => First (Choices (Expr)), | |
356 | Add_Space => False, | |
357 | Add_Paren => False) | |
1f41ed06 AC |
358 | & " => " & Expr_Name (Expression (Expr)) & ")"; |
359 | ||
360 | when N_If_Expression => | |
361 | declare | |
362 | N : constant Node_Id := First (Sinfo.Expressions (Expr)); | |
363 | begin | |
78cef47f AC |
364 | return |
365 | "if " & Expr_Name (N) & " then " | |
366 | & Expr_Name (Next (N)) & " else " | |
367 | & Expr_Name (Next (Next (N))); | |
1f41ed06 AC |
368 | end; |
369 | ||
370 | when N_Qualified_Expression => | |
371 | declare | |
372 | Mark : constant String := | |
78cef47f AC |
373 | Expr_Name |
374 | (Subtype_Mark (Expr), Expand_Type => False); | |
1f41ed06 AC |
375 | Str : constant String := Expr_Name (Expression (Expr)); |
376 | begin | |
377 | if Str (Str'First) = '(' and then Str (Str'Last) = ')' then | |
378 | return Mark & "'" & Str; | |
379 | else | |
380 | return Mark & "'(" & Str & ")"; | |
381 | end if; | |
382 | end; | |
383 | ||
384 | when N_Unchecked_Expression | N_Expression_With_Actions => | |
385 | return Expr_Name (Expression (Expr)); | |
386 | ||
387 | when N_Raise_Constraint_Error => | |
388 | if Present (Condition (Expr)) then | |
78cef47f AC |
389 | return |
390 | "[constraint_error when " | |
391 | & Expr_Name (Condition (Expr)) & "]"; | |
1f41ed06 AC |
392 | else |
393 | return "[constraint_error]"; | |
394 | end if; | |
395 | ||
396 | when N_Raise_Program_Error => | |
397 | if Present (Condition (Expr)) then | |
78cef47f AC |
398 | return |
399 | "[program_error when " | |
400 | & Expr_Name (Condition (Expr)) & "]"; | |
1f41ed06 AC |
401 | else |
402 | return "[program_error]"; | |
403 | end if; | |
404 | ||
405 | when N_Range => | |
78cef47f AC |
406 | return |
407 | Expr_Name (Low_Bound (Expr)) & ".." & | |
1f41ed06 AC |
408 | Expr_Name (High_Bound (Expr)); |
409 | ||
410 | when N_Slice => | |
78cef47f AC |
411 | return |
412 | Expr_Name (Prefix (Expr)) & " (" & | |
1f41ed06 AC |
413 | Expr_Name (Discrete_Range (Expr)) & ")"; |
414 | ||
415 | when N_And_Then => | |
78cef47f AC |
416 | return |
417 | Expr_Name (Left_Opnd (Expr)) & " and then " & | |
1f41ed06 AC |
418 | Expr_Name (Right_Opnd (Expr)); |
419 | ||
420 | when N_In => | |
78cef47f AC |
421 | return |
422 | Expr_Name (Left_Opnd (Expr)) & " in " & | |
1f41ed06 AC |
423 | Expr_Name (Right_Opnd (Expr)); |
424 | ||
425 | when N_Not_In => | |
78cef47f AC |
426 | return |
427 | Expr_Name (Left_Opnd (Expr)) & " not in " & | |
1f41ed06 AC |
428 | Expr_Name (Right_Opnd (Expr)); |
429 | ||
430 | when N_Or_Else => | |
78cef47f AC |
431 | return |
432 | Expr_Name (Left_Opnd (Expr)) & " or else " & | |
1f41ed06 AC |
433 | Expr_Name (Right_Opnd (Expr)); |
434 | ||
435 | when N_Op_And => | |
78cef47f AC |
436 | return |
437 | Expr_Name (Left_Opnd (Expr)) & " and " & | |
1f41ed06 AC |
438 | Expr_Name (Right_Opnd (Expr)); |
439 | ||
440 | when N_Op_Or => | |
78cef47f AC |
441 | return |
442 | Expr_Name (Left_Opnd (Expr)) & " or " & | |
1f41ed06 AC |
443 | Expr_Name (Right_Opnd (Expr)); |
444 | ||
445 | when N_Op_Xor => | |
78cef47f AC |
446 | return |
447 | Expr_Name (Left_Opnd (Expr)) & " xor " & | |
1f41ed06 AC |
448 | Expr_Name (Right_Opnd (Expr)); |
449 | ||
450 | when N_Op_Eq => | |
78cef47f AC |
451 | return |
452 | Expr_Name (Left_Opnd (Expr)) & " = " & | |
1f41ed06 AC |
453 | Expr_Name (Right_Opnd (Expr)); |
454 | ||
455 | when N_Op_Ne => | |
78cef47f AC |
456 | return |
457 | Expr_Name (Left_Opnd (Expr)) & " /= " & | |
1f41ed06 AC |
458 | Expr_Name (Right_Opnd (Expr)); |
459 | ||
460 | when N_Op_Lt => | |
78cef47f AC |
461 | return |
462 | Expr_Name (Left_Opnd (Expr)) & " < " & | |
1f41ed06 AC |
463 | Expr_Name (Right_Opnd (Expr)); |
464 | ||
465 | when N_Op_Le => | |
78cef47f AC |
466 | return |
467 | Expr_Name (Left_Opnd (Expr)) & " <= " & | |
1f41ed06 AC |
468 | Expr_Name (Right_Opnd (Expr)); |
469 | ||
470 | when N_Op_Gt => | |
78cef47f AC |
471 | return |
472 | Expr_Name (Left_Opnd (Expr)) & " > " & | |
1f41ed06 AC |
473 | Expr_Name (Right_Opnd (Expr)); |
474 | ||
475 | when N_Op_Ge => | |
78cef47f AC |
476 | return |
477 | Expr_Name (Left_Opnd (Expr)) & " >= " & | |
1f41ed06 AC |
478 | Expr_Name (Right_Opnd (Expr)); |
479 | ||
480 | when N_Op_Add => | |
78cef47f AC |
481 | return |
482 | Expr_Name (Left_Opnd (Expr)) & " + " & | |
1f41ed06 AC |
483 | Expr_Name (Right_Opnd (Expr)); |
484 | ||
485 | when N_Op_Subtract => | |
78cef47f AC |
486 | return |
487 | Expr_Name (Left_Opnd (Expr)) & " - " & | |
1f41ed06 AC |
488 | Expr_Name (Right_Opnd (Expr)); |
489 | ||
490 | when N_Op_Multiply => | |
78cef47f AC |
491 | return |
492 | Expr_Name (Left_Opnd (Expr)) & " * " & | |
1f41ed06 AC |
493 | Expr_Name (Right_Opnd (Expr)); |
494 | ||
495 | when N_Op_Divide => | |
78cef47f AC |
496 | return |
497 | Expr_Name (Left_Opnd (Expr)) & " / " & | |
1f41ed06 AC |
498 | Expr_Name (Right_Opnd (Expr)); |
499 | ||
500 | when N_Op_Mod => | |
78cef47f AC |
501 | return |
502 | Expr_Name (Left_Opnd (Expr)) & " mod " & | |
1f41ed06 AC |
503 | Expr_Name (Right_Opnd (Expr)); |
504 | ||
505 | when N_Op_Rem => | |
78cef47f AC |
506 | return |
507 | Expr_Name (Left_Opnd (Expr)) & " rem " & | |
1f41ed06 AC |
508 | Expr_Name (Right_Opnd (Expr)); |
509 | ||
510 | when N_Op_Expon => | |
78cef47f AC |
511 | return |
512 | Expr_Name (Left_Opnd (Expr)) & " ** " & | |
1f41ed06 AC |
513 | Expr_Name (Right_Opnd (Expr)); |
514 | ||
515 | when N_Op_Shift_Left => | |
78cef47f AC |
516 | return |
517 | Expr_Name (Left_Opnd (Expr)) & " << " & | |
1f41ed06 AC |
518 | Expr_Name (Right_Opnd (Expr)); |
519 | ||
520 | when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic => | |
78cef47f AC |
521 | return |
522 | Expr_Name (Left_Opnd (Expr)) & " >> " & | |
1f41ed06 AC |
523 | Expr_Name (Right_Opnd (Expr)); |
524 | ||
525 | when N_Op_Concat => | |
78cef47f AC |
526 | return |
527 | Expr_Name (Left_Opnd (Expr)) & " & " & | |
1f41ed06 AC |
528 | Expr_Name (Right_Opnd (Expr)); |
529 | ||
530 | when N_Op_Plus => | |
531 | return "+" & Expr_Name (Right_Opnd (Expr)); | |
532 | ||
533 | when N_Op_Minus => | |
534 | return "-" & Expr_Name (Right_Opnd (Expr)); | |
535 | ||
536 | when N_Op_Abs => | |
537 | return "abs " & Expr_Name (Right_Opnd (Expr)); | |
538 | ||
539 | when N_Op_Not => | |
540 | return "not (" & Expr_Name (Right_Opnd (Expr)) & ")"; | |
541 | ||
542 | when N_Parameter_Association => | |
543 | return Expr_Name (Explicit_Actual_Parameter (Expr)); | |
544 | ||
3ddfabe3 | 545 | when N_Type_Conversion => |
1f41ed06 AC |
546 | |
547 | -- Most conversions are not very interesting (used inside | |
548 | -- expanded checks to convert to larger ranges), so skip them. | |
549 | ||
550 | return Expr_Name (Expression (Expr)); | |
551 | ||
3ddfabe3 AC |
552 | when N_Unchecked_Type_Conversion => |
553 | ||
554 | -- Only keep the type conversion in complex cases | |
555 | ||
556 | if not Is_Scalar_Type (Etype (Expr)) | |
557 | or else not Is_Scalar_Type (Etype (Expression (Expr))) | |
558 | or else Is_Modular_Integer_Type (Etype (Expr)) | |
559 | /= Is_Modular_Integer_Type (Etype (Expression (Expr))) | |
560 | then | |
561 | return Expr_Name (Subtype_Mark (Expr)) & | |
562 | "(" & Expr_Name (Expression (Expr)) & ")"; | |
563 | else | |
564 | return Expr_Name (Expression (Expr)); | |
565 | end if; | |
566 | ||
1f41ed06 AC |
567 | when N_Indexed_Component => |
568 | if Take_Prefix then | |
78cef47f AC |
569 | return |
570 | Expr_Name (Prefix (Expr)) | |
571 | & List_Name (First (Sinfo.Expressions (Expr))); | |
1f41ed06 AC |
572 | else |
573 | return List_Name (First (Sinfo.Expressions (Expr))); | |
574 | end if; | |
575 | ||
576 | when N_Function_Call => | |
577 | ||
578 | -- If Default = "", it means we're expanding the name of | |
579 | -- a gnat temporary (and not really a function call), so add | |
580 | -- parentheses around function call to mark it specially. | |
581 | ||
582 | if Default = "" then | |
78cef47f AC |
583 | return '(' |
584 | & Expr_Name (Name (Expr)) | |
585 | & List_Name (First (Sinfo.Parameter_Associations (Expr))) | |
586 | & ')'; | |
1f41ed06 | 587 | else |
78cef47f AC |
588 | return |
589 | Expr_Name (Name (Expr)) | |
590 | & List_Name | |
591 | (First (Sinfo.Parameter_Associations (Expr))); | |
1f41ed06 AC |
592 | end if; |
593 | ||
594 | when N_Null => | |
595 | return "null"; | |
596 | ||
597 | when N_Others_Choice => | |
598 | return "others"; | |
599 | ||
600 | when others => | |
601 | return "..."; | |
602 | end case; | |
603 | end Expr_Name; | |
604 | ||
605 | -- Start of processing for Expression_Name | |
606 | ||
607 | begin | |
608 | if not From_Source then | |
609 | declare | |
610 | S : constant String := Expr_Name (Expr); | |
611 | begin | |
612 | if S = "..." then | |
613 | return Default; | |
614 | else | |
615 | return S; | |
616 | end if; | |
617 | end; | |
618 | end if; | |
619 | ||
620 | -- Compute left (start) and right (end) slocs for the expression | |
621 | -- Consider using Sinput.Sloc_Range instead, except that it does not | |
622 | -- work properly currently??? | |
623 | ||
624 | loop | |
625 | case Nkind (Left) is | |
78cef47f AC |
626 | when N_And_Then | |
627 | N_Binary_Op | | |
628 | N_Membership_Test | | |
629 | N_Or_Else => | |
1f41ed06 AC |
630 | Left := Original_Node (Left_Opnd (Left)); |
631 | ||
78cef47f AC |
632 | when N_Attribute_Reference | |
633 | N_Expanded_Name | | |
634 | N_Explicit_Dereference | | |
635 | N_Indexed_Component | | |
636 | N_Reference | | |
637 | N_Selected_Component | | |
638 | N_Slice => | |
1f41ed06 AC |
639 | Left := Original_Node (Prefix (Left)); |
640 | ||
78cef47f AC |
641 | when N_Defining_Program_Unit_Name | |
642 | N_Designator | | |
643 | N_Function_Call => | |
1f41ed06 AC |
644 | Left := Original_Node (Name (Left)); |
645 | ||
646 | when N_Range => | |
647 | Left := Original_Node (Low_Bound (Left)); | |
648 | ||
649 | when N_Type_Conversion => | |
650 | Left := Original_Node (Subtype_Mark (Left)); | |
651 | ||
652 | -- For any other item, quit loop | |
653 | ||
654 | when others => | |
655 | exit; | |
656 | end case; | |
657 | end loop; | |
658 | ||
659 | loop | |
660 | case Nkind (Right) is | |
78cef47f AC |
661 | when N_And_Then | |
662 | N_Membership_Test | | |
663 | N_Op | | |
664 | N_Or_Else => | |
1f41ed06 AC |
665 | Right := Original_Node (Right_Opnd (Right)); |
666 | ||
78cef47f AC |
667 | when N_Expanded_Name | |
668 | N_Selected_Component => | |
1f41ed06 AC |
669 | Right := Original_Node (Selector_Name (Right)); |
670 | ||
671 | when N_Designator => | |
672 | Right := Original_Node (Identifier (Right)); | |
673 | ||
674 | when N_Defining_Program_Unit_Name => | |
675 | Right := Original_Node (Defining_Identifier (Right)); | |
676 | ||
677 | when N_Range => | |
678 | Right := Original_Node (High_Bound (Right)); | |
679 | ||
680 | when N_Parameter_Association => | |
681 | Right := Original_Node (Explicit_Actual_Parameter (Right)); | |
682 | ||
683 | when N_Indexed_Component => | |
684 | Right := Original_Node (Last (Sinfo.Expressions (Right))); | |
685 | Append_Paren := True; | |
686 | ||
687 | when N_Function_Call => | |
688 | if Present (Sinfo.Parameter_Associations (Right)) then | |
a905304c AC |
689 | declare |
690 | Rover : Node_Id; | |
691 | Found : Boolean; | |
692 | ||
693 | begin | |
694 | -- Avoid source position confusion associated with | |
695 | -- parameters for which Comes_From_Source is False. | |
696 | ||
697 | Rover := First (Sinfo.Parameter_Associations (Right)); | |
698 | Found := False; | |
699 | while Present (Rover) loop | |
700 | if Comes_From_Source (Original_Node (Rover)) then | |
701 | Right := Original_Node (Rover); | |
702 | Append_Paren := True; | |
703 | Found := True; | |
704 | end if; | |
705 | ||
706 | Next (Rover); | |
707 | end loop; | |
708 | ||
709 | -- Quit loop if no Comes_From_Source parameters | |
710 | ||
711 | exit when not Found; | |
712 | end; | |
1f41ed06 | 713 | |
a905304c | 714 | -- Quit loop if no parameters |
1f41ed06 AC |
715 | |
716 | else | |
717 | exit; | |
718 | end if; | |
719 | ||
e699b76e AC |
720 | when N_Quantified_Expression => |
721 | Right := Original_Node (Condition (Right)); | |
722 | ||
1f41ed06 AC |
723 | -- For all other items, quit the loop |
724 | ||
725 | when others => | |
726 | exit; | |
727 | end case; | |
728 | end loop; | |
729 | ||
730 | declare | |
fb159eb7 | 731 | Scn : Source_Ptr := Original_Location (Sloc (Left)); |
1f41ed06 | 732 | End_Sloc : constant Source_Ptr := |
78cef47f AC |
733 | Original_Location (Sloc (Right)); |
734 | Src : constant Source_Buffer_Ptr := | |
735 | Source_Text (Get_Source_File_Index (Scn)); | |
1f41ed06 AC |
736 | |
737 | begin | |
738 | if Scn > End_Sloc then | |
739 | return Default; | |
740 | end if; | |
741 | ||
742 | declare | |
743 | Buffer : String (1 .. Natural (End_Sloc - Scn)); | |
78cef47f | 744 | Index : Natural := 0; |
1f41ed06 AC |
745 | Skipping_Comment : Boolean := False; |
746 | Underscore : Boolean := False; | |
1f41ed06 AC |
747 | |
748 | begin | |
749 | if Right /= Expr then | |
750 | while Scn < End_Sloc loop | |
751 | case Src (Scn) is | |
752 | when ' ' | ASCII.HT => | |
753 | if not Skipping_Comment and then not Underscore then | |
754 | Underscore := True; | |
755 | Index := Index + 1; | |
756 | Buffer (Index) := ' '; | |
757 | end if; | |
758 | ||
759 | -- CR/LF/FF is the end of any comment | |
760 | ||
761 | when ASCII.LF | ASCII.CR | ASCII.FF => | |
762 | Skipping_Comment := False; | |
763 | ||
764 | when others => | |
765 | Underscore := False; | |
766 | ||
767 | if not Skipping_Comment then | |
768 | ||
769 | -- Ignore comment | |
770 | ||
771 | if Src (Scn) = '-' and then Src (Scn + 1) = '-' then | |
772 | Skipping_Comment := True; | |
773 | ||
774 | else | |
775 | Index := Index + 1; | |
776 | Buffer (Index) := Src (Scn); | |
777 | end if; | |
778 | end if; | |
779 | end case; | |
780 | ||
781 | Scn := Scn + 1; | |
782 | end loop; | |
783 | end if; | |
784 | ||
785 | if Index < 1 then | |
786 | declare | |
787 | S : constant String := Expr_Name (Right); | |
788 | begin | |
789 | if S = "..." then | |
790 | return Default; | |
791 | else | |
792 | return S; | |
793 | end if; | |
794 | end; | |
795 | ||
796 | elsif Append_Paren then | |
797 | return Buffer (1 .. Index) & Expr_Name (Right, False) & ')'; | |
798 | ||
799 | else | |
800 | return Buffer (1 .. Index) & Expr_Name (Right, False); | |
801 | end if; | |
802 | end; | |
803 | end; | |
804 | end Expression_Image; | |
805 | ||
806 | end Pprint; |