1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                               P P R I N T                                --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 2008-2018, Free Software Foundation, Inc.         --
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;
27with Einfo;   use Einfo;
28with Namet;   use Namet;
29with Nlists;  use Nlists;
30with Opt;     use Opt;
31with Sinfo;   use Sinfo;
32with Sinput;  use Sinput;
33with Snames;  use Snames;
34with Uintp;   use Uintp;
35
36package 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
46   function Expression_Image
47     (Expr    : Node_Id;
48      Default : String) return String
49   is
50      From_Source  : constant Boolean :=
51                       Comes_From_Source (Expr)
52                         and then not Opt.Debug_Generated_Code;
53      Append_Paren : Boolean := False;
54      Left         : Node_Id := Original_Node (Expr);
55      Right        : Node_Id := Original_Node (Expr);
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
82      ---------------
83      -- List_Name --
84      ---------------
85
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;
97         --  ??? what does this do
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;
111            --  ??? what does this do
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
149            --  ??? the Internal_List_Name calls can be factored out
150
151            if First then
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));
158            else
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);
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;
178
179         declare
180            Result : constant String :=
181                       Internal_List_Name
182                         (List      => List,
183                          Add_Space => Add_Space,
184                          Add_Paren => Add_Paren);
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
209               | N_Identifier
210            =>
211               return Ident_Image (Expr, Expression_Image.Expr, Expand_Type);
212
213            when N_Character_Literal =>
214               declare
215                  Char : constant Int :=
216                           UI_To_Int (Char_Literal_Value (Expr));
217               begin
218                  if Char in 32 .. 127 then
219                     return "'" & Character'Val (Char) & "'";
220                  else
221                     UI_Image (Char_Literal_Value (Expr));
222                     return
223                       "'\" & UI_Image_Buffer (1 .. UI_Image_Length) & "'";
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
242                  return
243                    List_Name
244                      (List      => First (Sinfo.Expressions (Expr)),
245                       Add_Space => False);
246
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
255                  return ("(null record)");
256
257               else
258                  return
259                    List_Name
260                      (List      => First (Component_Associations (Expr)),
261                       Add_Space => False,
262                       Add_Paren => False);
263               end if;
264
265            when N_Extension_Aggregate =>
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) & ")";
271
272            when N_Attribute_Reference =>
273               if Take_Prefix then
274                  declare
275                     Id     : constant Attribute_Id :=
276                                Get_Attribute_Id (Attribute_Name (Expr));
277                     Str    : constant String :=
278                                Expr_Name (Prefix (Expr)) & "'"
279                                  & Get_Name_String (Attribute_Name (Expr));
280                     N      : Node_Id;
281                     Ranges : List_Id;
282
283                  begin
284                     if (Id = Attribute_First or else Id = Attribute_Last)
285                       and then Str (Str'First) = '$'
286                     then
287                        N := Associated_Node_For_Itype (Etype (Prefix (Expr)));
288
289                        if Present (N) then
290                           if Nkind (N) = N_Full_Type_Declaration then
291                              N := Type_Definition (N);
292                           end if;
293
294                           if Nkind (N) = N_Subtype_Declaration then
295                              Ranges :=
296                                Constraints
297                                  (Constraint (Subtype_Indication (N)));
298
299                              if List_Length (Ranges) = 1
300                                and then
301                                  Nkind_In
302                                    (First (Ranges),
303                                     N_Range,
304                                     N_Real_Range_Specification,
305                                     N_Signed_Integer_Type_Definition)
306                              then
307                                 if Id = Attribute_First then
308                                    return
309                                      Expression_Image
310                                        (Low_Bound (First (Ranges)), Str);
311                                 else
312                                    return
313                                      Expression_Image
314                                        (High_Bound (First (Ranges)), Str);
315                                 end if;
316                              end if;
317                           end if;
318                        end if;
319                     end if;
320
321                     return Str;
322                  end;
323               else
324                  return "'" & Get_Name_String (Attribute_Name (Expr));
325               end if;
326
327            when N_Explicit_Dereference =>
328               Explicit_Dereference : declare
329                  function Deref_Suffix return String;
330                  --  Usually returns ".all", but will return "" if
331                  --  Hide_Temp_Derefs is true and the prefix is a use of a
332                  --  not-from-source object declared as
333                  --    X : constant Some_Access_Type := Some_Expr'Reference;
334                  --  (as is sometimes done in Exp_Util.Remove_Side_Effects).
335
336                  ------------------
337                  -- Deref_Suffix --
338                  ------------------
339
340                  function Deref_Suffix return String is
341                     Decl : Node_Id;
342
343                  begin
344                     if Hide_Temp_Derefs
345                       and then Nkind (Prefix (Expr)) = N_Identifier
346                       and then Nkind (Entity (Prefix (Expr))) =
347                                  N_Defining_Identifier
348                     then
349                        Decl := Parent (Entity (Prefix (Expr)));
350
351                        if Present (Decl)
352                          and then Nkind (Decl) = N_Object_Declaration
353                          and then not Comes_From_Source (Decl)
354                          and then Constant_Present (Decl)
355                          and then Present (Sinfo.Expression (Decl))
356                          and then Nkind (Sinfo.Expression (Decl)) =
357                                     N_Reference
358                        then
359                           return "";
360                        end if;
361                     end if;
362
363                     --  The default case
364
365                     return ".all";
366                  end Deref_Suffix;
367
368               --  Start of processing for Explicit_Dereference
369
370               begin
371                  if Hide_Parameter_Blocks
372                    and then Nkind (Prefix (Expr)) = N_Selected_Component
373                    and then Present (Etype (Prefix (Expr)))
374                    and then Is_Access_Type (Etype (Prefix (Expr)))
375                    and then Is_Param_Block_Component_Type
376                               (Etype (Prefix (Expr)))
377                  then
378                     --  Return "Foo" instead of "Parameter_Block.Foo.all"
379
380                     return Expr_Name (Selector_Name (Prefix (Expr)));
381
382                  elsif Take_Prefix then
383                     return Expr_Name (Prefix (Expr)) & Deref_Suffix;
384                  else
385                     return Deref_Suffix;
386                  end if;
387               end Explicit_Dereference;
388
389            when N_Expanded_Name
390               | N_Selected_Component
391            =>
392               if Take_Prefix then
393                  return
394                    Expr_Name (Prefix (Expr)) & "." &
395                    Expr_Name (Selector_Name (Expr));
396               else
397                  return "." & Expr_Name (Selector_Name (Expr));
398               end if;
399
400            when N_Component_Association =>
401               return "("
402                 & List_Name
403                     (List      => First (Choices (Expr)),
404                      Add_Space => False,
405                      Add_Paren => False)
406                 & " => " & Expr_Name (Expression (Expr)) & ")";
407
408            when N_If_Expression =>
409               declare
410                  N : constant Node_Id := First (Sinfo.Expressions (Expr));
411               begin
412                  return
413                    "if " & Expr_Name (N) & " then "
414                      & Expr_Name (Next (N)) & " else "
415                      & Expr_Name (Next (Next (N)));
416               end;
417
418            when N_Qualified_Expression =>
419               declare
420                  Mark : constant String :=
421                           Expr_Name
422                             (Subtype_Mark (Expr), Expand_Type => False);
423                  Str  : constant String := Expr_Name (Expression (Expr));
424               begin
425                  if Str (Str'First) = '(' and then Str (Str'Last) = ')' then
426                     return Mark & "'" & Str;
427                  else
428                     return Mark & "'(" & Str & ")";
429                  end if;
430               end;
431
432            when N_Expression_With_Actions
433               | N_Unchecked_Expression
434            =>
435               return Expr_Name (Expression (Expr));
436
437            when N_Raise_Constraint_Error =>
438               if Present (Condition (Expr)) then
439                  return
440                    "[constraint_error when "
441                      & Expr_Name (Condition (Expr)) & "]";
442               else
443                  return "[constraint_error]";
444               end if;
445
446            when N_Raise_Program_Error =>
447               if Present (Condition (Expr)) then
448                  return
449                    "[program_error when "
450                      & Expr_Name (Condition (Expr)) & "]";
451               else
452                  return "[program_error]";
453               end if;
454
455            when N_Range =>
456               return
457                 Expr_Name (Low_Bound (Expr)) & ".." &
458                 Expr_Name (High_Bound (Expr));
459
460            when N_Slice =>
461               return
462                 Expr_Name (Prefix (Expr)) & " (" &
463                 Expr_Name (Discrete_Range (Expr)) & ")";
464
465            when N_And_Then =>
466               return
467                 Expr_Name (Left_Opnd (Expr)) & " and then " &
468                 Expr_Name (Right_Opnd (Expr));
469
470            when N_In =>
471               return
472                 Expr_Name (Left_Opnd (Expr)) & " in " &
473                 Expr_Name (Right_Opnd (Expr));
474
475            when N_Not_In =>
476               return
477                 Expr_Name (Left_Opnd (Expr)) & " not in " &
478                 Expr_Name (Right_Opnd (Expr));
479
480            when N_Or_Else =>
481               return
482                 Expr_Name (Left_Opnd (Expr)) & " or else " &
483                 Expr_Name (Right_Opnd (Expr));
484
485            when N_Op_And =>
486               return
487                 Expr_Name (Left_Opnd (Expr)) & " and " &
488                 Expr_Name (Right_Opnd (Expr));
489
490            when N_Op_Or =>
491               return
492                 Expr_Name (Left_Opnd (Expr)) & " or " &
493                 Expr_Name (Right_Opnd (Expr));
494
495            when N_Op_Xor =>
496               return
497                 Expr_Name (Left_Opnd (Expr)) & " xor " &
498                 Expr_Name (Right_Opnd (Expr));
499
500            when N_Op_Eq =>
501               return
502                 Expr_Name (Left_Opnd (Expr)) & " = " &
503                 Expr_Name (Right_Opnd (Expr));
504
505            when N_Op_Ne =>
506               return
507                 Expr_Name (Left_Opnd (Expr)) & " /= " &
508                 Expr_Name (Right_Opnd (Expr));
509
510            when N_Op_Lt =>
511               return
512                 Expr_Name (Left_Opnd (Expr)) & " < " &
513                 Expr_Name (Right_Opnd (Expr));
514
515            when N_Op_Le =>
516               return
517                 Expr_Name (Left_Opnd (Expr)) & " <= " &
518                 Expr_Name (Right_Opnd (Expr));
519
520            when N_Op_Gt =>
521               return
522                 Expr_Name (Left_Opnd (Expr)) & " > " &
523                 Expr_Name (Right_Opnd (Expr));
524
525            when N_Op_Ge =>
526               return
527                 Expr_Name (Left_Opnd (Expr)) & " >= " &
528                 Expr_Name (Right_Opnd (Expr));
529
530            when N_Op_Add =>
531               return
532                 Expr_Name (Left_Opnd (Expr)) & " + " &
533                 Expr_Name (Right_Opnd (Expr));
534
535            when N_Op_Subtract =>
536               return
537                 Expr_Name (Left_Opnd (Expr)) & " - " &
538                 Expr_Name (Right_Opnd (Expr));
539
540            when N_Op_Multiply =>
541               return
542                 Expr_Name (Left_Opnd (Expr)) & " * " &
543                 Expr_Name (Right_Opnd (Expr));
544
545            when N_Op_Divide =>
546               return
547                 Expr_Name (Left_Opnd (Expr)) & " / " &
548                 Expr_Name (Right_Opnd (Expr));
549
550            when N_Op_Mod =>
551               return
552                 Expr_Name (Left_Opnd (Expr)) & " mod " &
553                 Expr_Name (Right_Opnd (Expr));
554
555            when N_Op_Rem =>
556               return
557                 Expr_Name (Left_Opnd (Expr)) & " rem " &
558                 Expr_Name (Right_Opnd (Expr));
559
560            when N_Op_Expon =>
561               return
562                 Expr_Name (Left_Opnd (Expr)) & " ** " &
563                 Expr_Name (Right_Opnd (Expr));
564
565            when N_Op_Shift_Left =>
566               return
567                 Expr_Name (Left_Opnd (Expr)) & " << " &
568                 Expr_Name (Right_Opnd (Expr));
569
570            when N_Op_Shift_Right | N_Op_Shift_Right_Arithmetic =>
571               return
572                 Expr_Name (Left_Opnd (Expr)) & " >> " &
573                 Expr_Name (Right_Opnd (Expr));
574
575            when N_Op_Concat =>
576               return
577                 Expr_Name (Left_Opnd (Expr)) & " & " &
578                 Expr_Name (Right_Opnd (Expr));
579
580            when N_Op_Plus =>
581               return "+" & Expr_Name (Right_Opnd (Expr));
582
583            when N_Op_Minus =>
584               return "-" & Expr_Name (Right_Opnd (Expr));
585
586            when N_Op_Abs =>
587               return "abs " & Expr_Name (Right_Opnd (Expr));
588
589            when N_Op_Not =>
590               return "not (" & Expr_Name (Right_Opnd (Expr)) & ")";
591
592            when N_Parameter_Association =>
593               return Expr_Name (Explicit_Actual_Parameter (Expr));
594
595            when N_Type_Conversion =>
596
597               --  Most conversions are not very interesting (used inside
598               --  expanded checks to convert to larger ranges), so skip them.
599
600               return Expr_Name (Expression (Expr));
601
602            when N_Unchecked_Type_Conversion =>
603
604               --  Only keep the type conversion in complex cases
605
606               if not Is_Scalar_Type (Etype (Expr))
607                 or else not Is_Scalar_Type (Etype (Expression (Expr)))
608                 or else Is_Modular_Integer_Type (Etype (Expr)) /=
609                           Is_Modular_Integer_Type (Etype (Expression (Expr)))
610               then
611                  return Expr_Name (Subtype_Mark (Expr)) &
612                    "(" & Expr_Name (Expression (Expr)) & ")";
613               else
614                  return Expr_Name (Expression (Expr));
615               end if;
616
617            when N_Indexed_Component =>
618               if Take_Prefix then
619                  return
620                    Expr_Name (Prefix (Expr))
621                      & List_Name (First (Sinfo.Expressions (Expr)));
622               else
623                  return List_Name (First (Sinfo.Expressions (Expr)));
624               end if;
625
626            when N_Function_Call =>
627
628               --  If Default = "", it means we're expanding the name of
629               --  a gnat temporary (and not really a function call), so add
630               --  parentheses around function call to mark it specially.
631
632               if Default = "" then
633                  return '('
634                    & Expr_Name (Name (Expr))
635                    & List_Name (First (Sinfo.Parameter_Associations (Expr)))
636                    & ')';
637               else
638                  return
639                    Expr_Name (Name (Expr))
640                      & List_Name
641                          (First (Sinfo.Parameter_Associations (Expr)));
642               end if;
643
644            when N_Null =>
645               return "null";
646
647            when N_Others_Choice =>
648               return "others";
649
650            when others =>
651               return "...";
652         end case;
653      end Expr_Name;
654
655   --  Start of processing for Expression_Name
656
657   begin
658      if not From_Source then
659         declare
660            S : constant String := Expr_Name (Expr);
661         begin
662            if S = "..." then
663               return Default;
664            else
665               return S;
666            end if;
667         end;
668      end if;
669
670      --  Compute left (start) and right (end) slocs for the expression
671      --  Consider using Sinput.Sloc_Range instead, except that it does not
672      --  work properly currently???
673
674      loop
675         case Nkind (Left) is
676            when N_And_Then
677               | N_Binary_Op
678               | N_Membership_Test
679               | N_Or_Else
680            =>
681               Left := Original_Node (Left_Opnd (Left));
682
683            when N_Attribute_Reference
684               | N_Expanded_Name
685               | N_Explicit_Dereference
686               | N_Indexed_Component
687               | N_Reference
688               | N_Selected_Component
689               | N_Slice
690            =>
691               Left := Original_Node (Prefix (Left));
692
693            when N_Defining_Program_Unit_Name
694               | N_Designator
695               | N_Function_Call
696            =>
697               Left := Original_Node (Name (Left));
698
699            when N_Range =>
700               Left := Original_Node (Low_Bound (Left));
701
702            when N_Type_Conversion =>
703               Left := Original_Node (Subtype_Mark (Left));
704
705            --  For any other item, quit loop
706
707            when others =>
708               exit;
709         end case;
710      end loop;
711
712      loop
713         case Nkind (Right) is
714            when N_And_Then
715               | N_Membership_Test
716               | N_Op
717               | N_Or_Else
718            =>
719               Right := Original_Node (Right_Opnd (Right));
720
721            when N_Expanded_Name
722               | N_Selected_Component
723            =>
724               Right := Original_Node (Selector_Name (Right));
725
726            when N_Designator =>
727               Right := Original_Node (Identifier (Right));
728
729            when N_Defining_Program_Unit_Name =>
730               Right := Original_Node (Defining_Identifier (Right));
731
732            when N_Range =>
733               Right := Original_Node (High_Bound (Right));
734
735            when N_Parameter_Association =>
736               Right := Original_Node (Explicit_Actual_Parameter (Right));
737
738            when N_Indexed_Component =>
739               Right := Original_Node (Last (Sinfo.Expressions (Right)));
740               Append_Paren := True;
741
742            when N_Function_Call =>
743               if Present (Sinfo.Parameter_Associations (Right)) then
744                  declare
745                     Rover : Node_Id;
746                     Found : Boolean;
747
748                  begin
749                     --  Avoid source position confusion associated with
750                     --  parameters for which Comes_From_Source is False.
751
752                     Rover := First (Sinfo.Parameter_Associations (Right));
753                     Found := False;
754                     while Present (Rover) loop
755                        if Comes_From_Source (Original_Node (Rover)) then
756                           Right := Original_Node (Rover);
757                           Append_Paren := True;
758                           Found := True;
759                        end if;
760
761                        Next (Rover);
762                     end loop;
763
764                     --  Quit loop if no Comes_From_Source parameters
765
766                     exit when not Found;
767                  end;
768
769               --  Quit loop if no parameters
770
771               else
772                  exit;
773               end if;
774
775            when N_Quantified_Expression =>
776               Right := Original_Node (Condition (Right));
777
778            --  For all other items, quit the loop
779
780            when others =>
781               exit;
782         end case;
783      end loop;
784
785      declare
786         Scn      : Source_Ptr := Original_Location (Sloc (Left));
787         End_Sloc : constant Source_Ptr :=
788                      Original_Location (Sloc (Right));
789         Src      : constant Source_Buffer_Ptr :=
790                      Source_Text (Get_Source_File_Index (Scn));
791
792      begin
793         if Scn > End_Sloc then
794            return Default;
795         end if;
796
797         declare
798            Buffer           : String (1 .. Natural (End_Sloc - Scn));
799            Index            : Natural := 0;
800            Skipping_Comment : Boolean := False;
801            Underscore       : Boolean := False;
802
803         begin
804            if Right /= Expr then
805               while Scn < End_Sloc loop
806                  case Src (Scn) is
807                     when ' '
808                        | ASCII.HT
809                     =>
810                        if not Skipping_Comment and then not Underscore then
811                           Underscore := True;
812                           Index := Index + 1;
813                           Buffer (Index) := ' ';
814                        end if;
815
816                     --  CR/LF/FF is the end of any comment
817
818                     when ASCII.CR
819                        | ASCII.FF
820                        | ASCII.LF
821                     =>
822                        Skipping_Comment := False;
823
824                     when others =>
825                        Underscore := False;
826
827                        if not Skipping_Comment then
828
829                           --  Ignore comment
830
831                           if Src (Scn) = '-' and then Src (Scn + 1) = '-' then
832                              Skipping_Comment := True;
833
834                           else
835                              Index := Index + 1;
836                              Buffer (Index) := Src (Scn);
837                           end if;
838                        end if;
839                  end case;
840
841                  Scn := Scn + 1;
842               end loop;
843            end if;
844
845            if Index < 1 then
846               declare
847                  S : constant String := Expr_Name (Right);
848               begin
849                  if S = "..." then
850                     return Default;
851                  else
852                     return S;
853                  end if;
854               end;
855
856            elsif Append_Paren then
857               return Buffer (1 .. Index) & Expr_Name (Right, False) & ')';
858
859            else
860               return Buffer (1 .. Index) & Expr_Name (Right, False);
861            end if;
862         end;
863      end;
864   end Expression_Image;
865
866end Pprint;
867