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