1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2008-2014, 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 Atree; use Atree;
27 with Einfo; use Einfo;
28 with Namet; use Namet;
29 with Nlists; use Nlists;
31 with Sinfo; use Sinfo;
32 with Sinput; use Sinput;
33 with Snames; use Snames;
34 with Uintp; use Uintp;
36 package body Pprint is
38 List_Name_Count : Integer := 0;
39 -- Counter used to prevent infinite recursion while computing name of
40 -- complex expressions.
42 ----------------------
43 -- Expression_Image --
44 ----------------------
46 function Expression_Image (Expr : Node_Id; Default : String)
48 Left : Node_Id := Original_Node (Expr);
49 Right : Node_Id := Original_Node (Expr);
50 From_Source : constant Boolean :=
51 Comes_From_Source (Expr) and then not Opt.Debug_Generated_Code;
52 Append_Paren : Boolean := False;
56 Take_Prefix : Boolean := True;
57 Expand_Type : Boolean := True) return String;
58 -- Return string corresponding to Expr. If no string can be extracted,
59 -- return "...". If Take_Prefix is True, go back to prefix when needed,
60 -- otherwise only consider the right-hand side of an expression. If
61 -- Expand_Type is True and Expr is a type, try to expand Expr (an
62 -- internally generated type) into a user understandable name.
64 Max_List : constant := 3;
65 -- Limit number of list elements to dump
67 Max_Expr_Elements : constant := 24;
68 -- Limit number of elements in an expression for use by Expr_Name
70 Num_Elements : Natural := 0;
71 -- Current number of elements processed by Expr_Name
75 Add_Space : Boolean := True;
76 Add_Paren : Boolean := True) return String;
77 -- Return a string corresponding to List
81 Add_Space : Boolean := True;
82 Add_Paren : Boolean := True) return String
84 function Internal_List_Name
86 First : Boolean := True;
87 Add_Space : Boolean := True;
88 Add_Paren : Boolean := True;
89 Num : Natural := 1) return String;
91 ------------------------
92 -- Internal_List_Name --
93 ------------------------
95 function Internal_List_Name
97 First : Boolean := True;
98 Add_Space : Boolean := True;
99 Add_Paren : Boolean := True;
100 Num : Natural := 1) return String
102 function Prepend (S : String) return String;
108 function Prepend (S : String) return String is
123 -- Start of processing for Internal_List_Name
126 if not Present (List) then
127 if First or else not Add_Paren then
132 elsif Num > Max_List then
143 & Internal_List_Name (Next (List),
145 Add_Paren => Add_Paren,
148 return ", " & Expr_Name (List) &
152 Add_Paren => Add_Paren,
155 end Internal_List_Name;
157 -- Start of processing for List_Name
160 -- Prevent infinite recursion by limiting depth to 3
162 if List_Name_Count > 3 then
166 List_Name_Count := List_Name_Count + 1;
168 Result : constant String :=
170 (List, Add_Space => Add_Space, Add_Paren => Add_Paren);
172 List_Name_Count := List_Name_Count - 1;
183 Take_Prefix : Boolean := True;
184 Expand_Type : Boolean := True) return String
187 Num_Elements := Num_Elements + 1;
189 if Num_Elements > Max_Expr_Elements then
194 when N_Defining_Identifier | N_Identifier =>
195 return Ident_Image (Expr, Expression_Image.Expr, Expand_Type);
197 when N_Character_Literal =>
199 Char : constant Int :=
200 UI_To_Int (Char_Literal_Value (Expr));
202 if Char in 32 .. 127 then
203 return "'" & Character'Val (Char) & "'";
205 UI_Image (Char_Literal_Value (Expr));
206 return "'\" & UI_Image_Buffer (1 .. UI_Image_Length)
211 when N_Integer_Literal =>
212 UI_Image (Intval (Expr));
213 return UI_Image_Buffer (1 .. UI_Image_Length);
215 when N_Real_Literal =>
216 return Real_Image (Realval (Expr));
218 when N_String_Literal =>
219 return String_Image (Strval (Expr));
222 return "new " & Expr_Name (Expression (Expr));
225 if Present (Sinfo.Expressions (Expr)) then
227 (First (Sinfo.Expressions (Expr)), Add_Space => False);
229 -- Do not return empty string for (others => <>) aggregate
230 -- of a componentless record type. At least one caller (the
231 -- recursive call below in the N_Qualified_Expression case)
232 -- is not prepared to deal with a zero-length result.
234 elsif Null_Record_Present (Expr)
235 or else not Present (First (Component_Associations (Expr)))
237 return ("(null record)");
241 (First (Component_Associations (Expr)),
242 Add_Space => False, Add_Paren => False);
245 when N_Extension_Aggregate =>
246 return "(" & Expr_Name (Ancestor_Part (Expr)) &
248 List_Name (First (Sinfo.Expressions (Expr)),
249 Add_Space => False, Add_Paren => False) &
252 when N_Attribute_Reference =>
255 Str : constant String := Expr_Name (Prefix (Expr))
256 & "'" & Get_Name_String (Attribute_Name (Expr));
257 Id : constant Attribute_Id :=
258 Get_Attribute_Id (Attribute_Name (Expr));
263 if (Id = Attribute_First or else Id = Attribute_Last)
264 and then Str (Str'First) = '$'
266 N := Associated_Node_For_Itype (Etype (Prefix (Expr)));
269 if Nkind (N) = N_Full_Type_Declaration then
270 N := Type_Definition (N);
273 if Nkind (N) = N_Subtype_Declaration then
274 Ranges := Constraints (Constraint
275 (Subtype_Indication (N)));
277 if List_Length (Ranges) = 1
281 N_Real_Range_Specification,
282 N_Signed_Integer_Type_Definition)
284 if Id = Attribute_First then
285 return Expression_Image
286 (Low_Bound (First (Ranges)), Str);
288 return Expression_Image
289 (High_Bound (First (Ranges)), Str);
299 return "'" & Get_Name_String (Attribute_Name (Expr));
302 when N_Explicit_Dereference =>
304 return Expr_Name (Prefix (Expr)) & ".all";
309 when N_Expanded_Name | N_Selected_Component =>
311 return Expr_Name (Prefix (Expr))
312 & "." & Expr_Name (Selector_Name (Expr));
314 return "." & Expr_Name (Selector_Name (Expr));
317 when N_Component_Association =>
319 & List_Name (First (Choices (Expr)),
320 Add_Space => False, Add_Paren => False)
321 & " => " & Expr_Name (Expression (Expr)) & ")";
323 when N_If_Expression =>
325 N : constant Node_Id := First (Sinfo.Expressions (Expr));
327 return "if " & Expr_Name (N) & " then " &
328 Expr_Name (Next (N)) & " else " &
329 Expr_Name (Next (Next (N)));
332 when N_Qualified_Expression =>
334 Mark : constant String :=
335 Expr_Name (Subtype_Mark (Expr), Expand_Type => False);
336 Str : constant String := Expr_Name (Expression (Expr));
338 if Str (Str'First) = '(' and then Str (Str'Last) = ')' then
339 return Mark & "'" & Str;
341 return Mark & "'(" & Str & ")";
345 when N_Unchecked_Expression | N_Expression_With_Actions =>
346 return Expr_Name (Expression (Expr));
348 when N_Raise_Constraint_Error =>
349 if Present (Condition (Expr)) then
350 return "[constraint_error when " &
351 Expr_Name (Condition (Expr)) & "]";
353 return "[constraint_error]";
356 when N_Raise_Program_Error =>
357 if Present (Condition (Expr)) then
358 return "[program_error when " &
359 Expr_Name (Condition (Expr)) & "]";
361 return "[program_error]";
365 return Expr_Name (Low_Bound (Expr)) & ".." &
366 Expr_Name (High_Bound (Expr));
369 return Expr_Name (Prefix (Expr)) & " (" &
370 Expr_Name (Discrete_Range (Expr)) & ")";
373 return Expr_Name (Left_Opnd (Expr)) & " and then " &
374 Expr_Name (Right_Opnd (Expr));
377 return Expr_Name (Left_Opnd (Expr)) & " in " &
378 Expr_Name (Right_Opnd (Expr));
381 return Expr_Name (Left_Opnd (Expr)) & " not in " &
382 Expr_Name (Right_Opnd (Expr));
385 return Expr_Name (Left_Opnd (Expr)) & " or else " &
386 Expr_Name (Right_Opnd (Expr));
389 return Expr_Name (Left_Opnd (Expr)) & " and " &
390 Expr_Name (Right_Opnd (Expr));
393 return Expr_Name (Left_Opnd (Expr)) & " or " &
394 Expr_Name (Right_Opnd (Expr));
397 return Expr_Name (Left_Opnd (Expr)) & " xor " &
398 Expr_Name (Right_Opnd (Expr));
401 return Expr_Name (Left_Opnd (Expr)) & " = " &
402 Expr_Name (Right_Opnd (Expr));
405 return Expr_Name (Left_Opnd (Expr)) & " /= " &
406 Expr_Name (Right_Opnd (Expr));
409 return Expr_Name (Left_Opnd (Expr)) & " < " &
410 Expr_Name (Right_Opnd (Expr));
413 return Expr_Name (Left_Opnd (Expr)) & " <= " &
414 Expr_Name (Right_Opnd (Expr));
417 return Expr_Name (Left_Opnd (Expr)) & " > " &
418 Expr_Name (Right_Opnd (Expr));
421 return Expr_Name (Left_Opnd (Expr)) & " >= " &
422 Expr_Name (Right_Opnd (Expr));
425 return Expr_Name (Left_Opnd (Expr)) & " + " &
426 Expr_Name (Right_Opnd (Expr));
428 when N_Op_Subtract =>
429 return Expr_Name (Left_Opnd (Expr)) & " - " &
430 Expr_Name (Right_Opnd (Expr));
432 when N_Op_Multiply =>
433 return Expr_Name (Left_Opnd (Expr)) & " * " &
434 Expr_Name (Right_Opnd (Expr));
437 return Expr_Name (Left_Opnd (Expr)) & " / " &
438 Expr_Name (Right_Opnd (Expr));
441 return Expr_Name (Left_Opnd (Expr)) & " mod " &
442 Expr_Name (Right_Opnd (Expr));
445 return Expr_Name (Left_Opnd (Expr)) & " rem " &
446 Expr_Name (Right_Opnd (Expr));
449 return Expr_Name (Left_Opnd (Expr)) & " ** " &
450 Expr_Name (Right_Opnd (Expr));
452 when N_Op_Shift_Left =>
453 return Expr_Name (Left_Opnd (Expr)) & " << " &
454 Expr_Name (Right_Opnd (Expr));
456 when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic =>
457 return Expr_Name (Left_Opnd (Expr)) & " >> " &
458 Expr_Name (Right_Opnd (Expr));
461 return Expr_Name (Left_Opnd (Expr)) & " & " &
462 Expr_Name (Right_Opnd (Expr));
465 return "+" & Expr_Name (Right_Opnd (Expr));
468 return "-" & Expr_Name (Right_Opnd (Expr));
471 return "abs " & Expr_Name (Right_Opnd (Expr));
474 return "not (" & Expr_Name (Right_Opnd (Expr)) & ")";
476 when N_Parameter_Association =>
477 return Expr_Name (Explicit_Actual_Parameter (Expr));
479 when N_Type_Conversion | N_Unchecked_Type_Conversion =>
481 -- Most conversions are not very interesting (used inside
482 -- expanded checks to convert to larger ranges), so skip them.
484 return Expr_Name (Expression (Expr));
486 when N_Indexed_Component =>
488 return Expr_Name (Prefix (Expr)) &
489 List_Name (First (Sinfo.Expressions (Expr)));
491 return List_Name (First (Sinfo.Expressions (Expr)));
494 when N_Function_Call =>
496 -- If Default = "", it means we're expanding the name of
497 -- a gnat temporary (and not really a function call), so add
498 -- parentheses around function call to mark it specially.
501 return '(' & Expr_Name (Name (Expr)) &
502 List_Name (First (Sinfo.Parameter_Associations (Expr))) &
505 return Expr_Name (Name (Expr)) &
506 List_Name (First (Sinfo.Parameter_Associations (Expr)));
512 when N_Others_Choice =>
520 -- Start of processing for Expression_Name
523 if not From_Source then
525 S : constant String := Expr_Name (Expr);
535 -- Compute left (start) and right (end) slocs for the expression
536 -- Consider using Sinput.Sloc_Range instead, except that it does not
537 -- work properly currently???
541 when N_Binary_Op | N_Membership_Test |
542 N_And_Then | N_Or_Else =>
543 Left := Original_Node (Left_Opnd (Left));
545 when N_Attribute_Reference | N_Expanded_Name |
546 N_Explicit_Dereference | N_Indexed_Component |
547 N_Reference | N_Selected_Component |
549 Left := Original_Node (Prefix (Left));
551 when N_Designator | N_Defining_Program_Unit_Name |
553 Left := Original_Node (Name (Left));
556 Left := Original_Node (Low_Bound (Left));
558 when N_Type_Conversion =>
559 Left := Original_Node (Subtype_Mark (Left));
561 -- For any other item, quit loop
569 case Nkind (Right) is
570 when N_Op | N_Membership_Test |
571 N_And_Then | N_Or_Else =>
572 Right := Original_Node (Right_Opnd (Right));
574 when N_Selected_Component | N_Expanded_Name =>
575 Right := Original_Node (Selector_Name (Right));
578 Right := Original_Node (Identifier (Right));
580 when N_Defining_Program_Unit_Name =>
581 Right := Original_Node (Defining_Identifier (Right));
584 Right := Original_Node (High_Bound (Right));
586 when N_Parameter_Association =>
587 Right := Original_Node (Explicit_Actual_Parameter (Right));
589 when N_Indexed_Component =>
590 Right := Original_Node (Last (Sinfo.Expressions (Right)));
591 Append_Paren := True;
593 when N_Function_Call =>
594 if Present (Sinfo.Parameter_Associations (Right)) then
600 -- Avoid source position confusion associated with
601 -- parameters for which Comes_From_Source is False.
603 Rover := First (Sinfo.Parameter_Associations (Right));
605 while Present (Rover) loop
606 if Comes_From_Source (Original_Node (Rover)) then
607 Right := Original_Node (Rover);
608 Append_Paren := True;
615 -- Quit loop if no Comes_From_Source parameters
620 -- Quit loop if no parameters
626 when N_Quantified_Expression =>
627 Right := Original_Node (Condition (Right));
629 -- For all other items, quit the loop
637 Scn : Source_Ptr := Original_Location (Sloc (Left));
638 Src : constant Source_Buffer_Ptr :=
639 Source_Text (Get_Source_File_Index (Scn));
640 End_Sloc : constant Source_Ptr :=
641 Original_Location (Sloc (Right));
644 if Scn > End_Sloc then
649 Buffer : String (1 .. Natural (End_Sloc - Scn));
650 Skipping_Comment : Boolean := False;
651 Underscore : Boolean := False;
652 Index : Natural := 0;
655 if Right /= Expr then
656 while Scn < End_Sloc loop
658 when ' ' | ASCII.HT =>
659 if not Skipping_Comment and then not Underscore then
662 Buffer (Index) := ' ';
665 -- CR/LF/FF is the end of any comment
667 when ASCII.LF | ASCII.CR | ASCII.FF =>
668 Skipping_Comment := False;
673 if not Skipping_Comment then
677 if Src (Scn) = '-' and then Src (Scn + 1) = '-' then
678 Skipping_Comment := True;
682 Buffer (Index) := Src (Scn);
693 S : constant String := Expr_Name (Right);
702 elsif Append_Paren then
703 return Buffer (1 .. Index) & Expr_Name (Right, False) & ')';
706 return Buffer (1 .. Index) & Expr_Name (Right, False);
710 end Expression_Image;