gcc/ada/pprint.adb

   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-2017, 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
  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
  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
 866 end Pprint;