gcc/ada/sprint.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               S P R I N T                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2005, 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 2,  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 COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with Atree;    use Atree;
  28 with Casing;   use Casing;
  29 with Csets;    use Csets;
  30 with Debug;    use Debug;
  31 with Einfo;    use Einfo;
  32 with Lib;      use Lib;
  33 with Namet;    use Namet;
  34 with Nlists;   use Nlists;
  35 with Opt;      use Opt;
  36 with Output;   use Output;
  37 with Rtsfind;  use Rtsfind;
  38 with Sinfo;    use Sinfo;
  39 with Sinput;   use Sinput;
  40 with Sinput.D; use Sinput.D;
  41 with Snames;   use Snames;
  42 with Stand;    use Stand;
  43 with Stringt;  use Stringt;
  44 with Uintp;    use Uintp;
  45 with Uname;    use Uname;
  46 with Urealp;   use Urealp;
  47
  48 package body Sprint is
  49
  50    Debug_Node : Node_Id := Empty;
  51    --  If we are in Debug_Generated_Code mode, then this location is set
  52    --  to the current node requiring Sloc fixup, until Set_Debug_Sloc is
  53    --  called to set the proper value. The call clears it back to Empty.
  54
  55    Debug_Sloc : Source_Ptr;
  56    --  Sloc of first byte of line currently being written if we are
  57    --  generating a source debug file.
  58
  59    Dump_Original_Only : Boolean;
  60    --  Set True if the -gnatdo (dump original tree) flag is set
  61
  62    Dump_Generated_Only : Boolean;
  63    --  Set True if the -gnatG (dump generated tree) debug flag is set
  64    --  or for Print_Generated_Code (-gnatG) or Dump_Generated_Code (-gnatD).
  65
  66    Dump_Freeze_Null : Boolean;
  67    --  Set True if freeze nodes and non-source null statements output
  68
  69    Indent : Int := 0;
  70    --  Number of columns for current line output indentation
  71
  72    Indent_Annull_Flag : Boolean := False;
  73    --  Set True if subsequent Write_Indent call to be ignored, gets reset
  74    --  by this call, so it is only active to suppress a single indent call.
  75
  76    Line_Limit : constant := 72;
  77    --  Limit value for chopping long lines
  78
  79    Freeze_Indent : Int := 0;
  80    --  Keep track of freeze indent level (controls blank lines before
  81    --  procedures within expression freeze actions)
  82
  83    -------------------------------
  84    -- Operator Precedence Table --
  85    -------------------------------
  86
  87    --  This table is used to decide whether a subexpression needs to be
  88    --  parenthesized. The rule is that if an operand of an operator (which
  89    --  for this purpose includes AND THEN and OR ELSE) is itself an operator
  90    --  with a lower precedence than the operator (or equal precedence if
  91    --  appearing as the right operand), then parentheses are required.
  92
  93    Op_Prec : constant array (N_Subexpr) of Short_Short_Integer :=
  94                (N_Op_And          => 1,
  95                 N_Op_Or           => 1,
  96                 N_Op_Xor          => 1,
  97                 N_And_Then        => 1,
  98                 N_Or_Else         => 1,
  99
 100                 N_In              => 2,
 101                 N_Not_In          => 2,
 102                 N_Op_Eq           => 2,
 103                 N_Op_Ge           => 2,
 104                 N_Op_Gt           => 2,
 105                 N_Op_Le           => 2,
 106                 N_Op_Lt           => 2,
 107                 N_Op_Ne           => 2,
 108
 109                 N_Op_Add          => 3,
 110                 N_Op_Concat       => 3,
 111                 N_Op_Subtract     => 3,
 112                 N_Op_Plus         => 3,
 113                 N_Op_Minus        => 3,
 114
 115                 N_Op_Divide       => 4,
 116                 N_Op_Mod          => 4,
 117                 N_Op_Rem          => 4,
 118                 N_Op_Multiply     => 4,
 119
 120                 N_Op_Expon        => 5,
 121                 N_Op_Abs          => 5,
 122                 N_Op_Not          => 5,
 123
 124                 others            => 6);
 125
 126    procedure Sprint_Left_Opnd (N : Node_Id);
 127    --  Print left operand of operator, parenthesizing if necessary
 128
 129    procedure Sprint_Right_Opnd (N : Node_Id);
 130    --  Print right operand of operator, parenthesizing if necessary
 131
 132    -----------------------
 133    -- Local Subprograms --
 134    -----------------------
 135
 136    procedure Col_Check (N : Nat);
 137    --  Check that at least N characters remain on current line, and if not,
 138    --  then start an extra line with two characters extra indentation for
 139    --  continuing text on the next line.
 140
 141    procedure Indent_Annull;
 142    --  Causes following call to Write_Indent to be ignored. This is used when
 143    --  a higher level node wants to stop a lower level node from starting a
 144    --  new line, when it would otherwise be inclined to do so (e.g. the case
 145    --  of an accept statement called from an accept alternative with a guard)
 146
 147    procedure Indent_Begin;
 148    --  Increase indentation level
 149
 150    procedure Indent_End;
 151    --  Decrease indentation level
 152
 153    procedure Print_Debug_Line (S : String);
 154    --  Used to print output lines in Debug_Generated_Code mode (this is used
 155    --  as the argument for a call to Set_Special_Output in package Output).
 156
 157    procedure Process_TFAI_RR_Flags (Nod : Node_Id);
 158    --  Given a divide, multiplication or division node, check the flags
 159    --  Treat_Fixed_As_Integer and Rounded_Flags, and if set, output the
 160    --  appropriate special syntax characters (# and @).
 161
 162    procedure Set_Debug_Sloc;
 163    --  If Debug_Node is non-empty, this routine sets the appropriate value
 164    --  in its Sloc field, from the current location in the debug source file
 165    --  that is currently being written. Note that Debug_Node is always empty
 166    --  if a debug source file is not being written.
 167
 168    procedure Sprint_And_List (List : List_Id);
 169    --  Print the given list with items separated by vertical "and"
 170
 171    procedure Sprint_Bar_List (List : List_Id);
 172    --  Print the given list with items separated by vertical bars
 173
 174    procedure Sprint_Node_Actual (Node : Node_Id);
 175    --  This routine prints its node argument. It is a lower level routine than
 176    --  Sprint_Node, in that it does not bother about rewritten trees.
 177
 178    procedure Sprint_Node_Sloc (Node : Node_Id);
 179    --  Like Sprint_Node, but in addition, in Debug_Generated_Code mode,
 180    --  sets the Sloc of the current debug node to be a copy of the Sloc
 181    --  of the sprinted node Node. Note that this is done after printing
 182    --  Node, so that the Sloc is the proper updated value for the debug file.
 183
 184    procedure Write_Char_Sloc (C : Character);
 185    --  Like Write_Char, except that if C is non-blank, Set_Debug_Sloc is
 186    --  called to ensure that the current node has a proper Sloc set.
 187
 188    procedure Write_Condition_And_Reason (Node : Node_Id);
 189    --  Write Condition and Reason codes of Raise_xxx_Error node
 190
 191    procedure Write_Discr_Specs (N : Node_Id);
 192    --  Ouput discriminant specification for node, which is any of the type
 193    --  declarations that can have discriminants.
 194
 195    procedure Write_Ekind (E : Entity_Id);
 196    --  Write the String corresponding to the Ekind without "E_".
 197
 198    procedure Write_Id (N : Node_Id);
 199    --  N is a node with a Chars field. This procedure writes the name that
 200    --  will be used in the generated code associated with the name. For a
 201    --  node with no associated entity, this is simply the Chars field. For
 202    --  the case where there is an entity associated with the node, we print
 203    --  the name associated with the entity (since it may have been encoded).
 204    --  One other special case is that an entity has an active external name
 205    --  (i.e. an external name present with no address clause), then this
 206    --  external name is output.
 207
 208    function Write_Identifiers (Node : Node_Id) return Boolean;
 209    --  Handle node where the grammar has a list of defining identifiers, but
 210    --  the tree has a separate declaration for each identifier. Handles the
 211    --  printing of the defining identifier, and returns True if the type and
 212    --  initialization information is to be printed, False if it is to be
 213    --  skipped (the latter case happens when printing defining identifiers
 214    --  other than the first in the original tree output case).
 215
 216    procedure Write_Implicit_Def (E : Entity_Id);
 217    pragma Warnings (Off, Write_Implicit_Def);
 218    --  Write the definition of the implicit type E according to its Ekind
 219    --  For now a debugging procedure, but might be used in the future.
 220
 221    procedure Write_Indent;
 222    --  Start a new line and write indentation spacing
 223
 224    function Write_Indent_Identifiers (Node : Node_Id) return Boolean;
 225    --  Like Write_Identifiers except that each new printed declaration
 226    --  is at the start of a new line.
 227
 228    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean;
 229    --  Like Write_Indent_Identifiers except that in Debug_Generated_Code
 230    --  mode, the Sloc of the current debug node is set to point ot the
 231    --  first output identifier.
 232
 233    procedure Write_Indent_Str (S : String);
 234    --  Start a new line and write indent spacing followed by given string
 235
 236    procedure Write_Indent_Str_Sloc (S : String);
 237    --  Like Write_Indent_Str, but in addition, in Debug_Generated_Code mode,
 238    --  the Sloc of the current node is set to the first non-blank character
 239    --  in the string S.
 240
 241    procedure Write_Name_With_Col_Check (N : Name_Id);
 242    --  Write name (using Write_Name) with initial column check, and possible
 243    --  initial Write_Indent (to get new line) if current line is too full.
 244
 245    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id);
 246    --  Like Write_Name_With_Col_Check but in addition, in Debug_Generated_Code
 247    --  mode, sets Sloc of current debug node to first character of name.
 248
 249    procedure Write_Operator (N : Node_Id; S : String);
 250    --  Like Write_Str_Sloc, used for operators, encloses the string in
 251    --  characters {} if the Do_Overflow flag is set on the node N.
 252
 253    procedure Write_Param_Specs (N : Node_Id);
 254    --  Output parameter specifications for node (which is either a function
 255    --  or procedure specification with a Parameter_Specifications field)
 256
 257    procedure Write_Rewrite_Str (S : String);
 258    --  Writes out a string (typically containing <<< or >>>}) for a node
 259    --  created by rewriting the tree. Suppressed if we are outputting the
 260    --  generated code only, since in this case we don't specially mark nodes
 261    --  created by rewriting).
 262
 263    procedure Write_Str_Sloc (S : String);
 264    --  Like Write_Str, but sets debug Sloc of current debug node to first
 265    --  non-blank character if a current debug node is active.
 266
 267    procedure Write_Str_With_Col_Check (S : String);
 268    --  Write string (using Write_Str) with initial column check, and possible
 269    --  initial Write_Indent (to get new line) if current line is too full.
 270
 271    procedure Write_Str_With_Col_Check_Sloc (S : String);
 272    --  Like Write_Str_WIth_Col_Check, but sets debug Sloc of current debug
 273    --  node to first non-blank character if a current debug node is active.
 274
 275    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format);
 276    --  Write Uint (using UI_Write) with initial column check, and possible
 277    --  initial Write_Indent (to get new line) if current line is too full.
 278    --  The format parameter determines the output format (see UI_Write).
 279    --  In addition, in Debug_Generated_Code mode, sets the current node
 280    --  Sloc to the first character of the output value.
 281
 282    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal);
 283    --  Write Ureal (using same output format as UR_Write) with column checks
 284    --  and a possible initial Write_Indent (to get new line) if current line
 285    --  is too full. In addition, in Debug_Generated_Code mode, sets the
 286    --  current node Sloc to the first character of the output value.
 287
 288    ---------------
 289    -- Col_Check --
 290    ---------------
 291
 292    procedure Col_Check (N : Nat) is
 293    begin
 294       if N + Column > Line_Limit then
 295          Write_Indent_Str ("  ");
 296       end if;
 297    end Col_Check;
 298
 299    -------------------
 300    -- Indent_Annull --
 301    -------------------
 302
 303    procedure Indent_Annull is
 304    begin
 305       Indent_Annull_Flag := True;
 306    end Indent_Annull;
 307
 308    ------------------
 309    -- Indent_Begin --
 310    ------------------
 311
 312    procedure Indent_Begin is
 313    begin
 314       Indent := Indent + 3;
 315    end Indent_Begin;
 316
 317    ----------------
 318    -- Indent_End --
 319    ----------------
 320
 321    procedure Indent_End is
 322    begin
 323       Indent := Indent - 3;
 324    end Indent_End;
 325
 326    --------
 327    -- pg --
 328    --------
 329
 330    procedure pg (Node : Node_Id) is
 331    begin
 332       Dump_Generated_Only := True;
 333       Dump_Original_Only := False;
 334       Sprint_Node (Node);
 335       Write_Eol;
 336    end pg;
 337
 338    --------
 339    -- po --
 340    --------
 341
 342    procedure po (Node : Node_Id) is
 343    begin
 344       Dump_Generated_Only := False;
 345       Dump_Original_Only := True;
 346       Sprint_Node (Node);
 347       Write_Eol;
 348    end po;
 349
 350    ----------------------
 351    -- Print_Debug_Line --
 352    ----------------------
 353
 354    procedure Print_Debug_Line (S : String) is
 355    begin
 356       Write_Debug_Line (S, Debug_Sloc);
 357    end Print_Debug_Line;
 358
 359    ---------------------------
 360    -- Process_TFAI_RR_Flags --
 361    ---------------------------
 362
 363    procedure Process_TFAI_RR_Flags (Nod : Node_Id) is
 364    begin
 365       if Treat_Fixed_As_Integer (Nod) then
 366          Write_Char ('#');
 367       end if;
 368
 369       if Rounded_Result (Nod) then
 370          Write_Char ('@');
 371       end if;
 372    end Process_TFAI_RR_Flags;
 373
 374    --------
 375    -- ps --
 376    --------
 377
 378    procedure ps (Node : Node_Id) is
 379    begin
 380       Dump_Generated_Only := False;
 381       Dump_Original_Only := False;
 382       Sprint_Node (Node);
 383       Write_Eol;
 384    end ps;
 385
 386    --------------------
 387    -- Set_Debug_Sloc --
 388    --------------------
 389
 390    procedure Set_Debug_Sloc is
 391    begin
 392       if Present (Debug_Node) then
 393          Set_Sloc (Debug_Node, Debug_Sloc + Source_Ptr (Column - 1));
 394          Debug_Node := Empty;
 395       end if;
 396    end Set_Debug_Sloc;
 397
 398    -----------------
 399    -- Source_Dump --
 400    -----------------
 401
 402    procedure Source_Dump is
 403
 404       procedure Underline;
 405       --  Put underline under string we just printed
 406
 407       procedure Underline is
 408          Col : constant Int := Column;
 409
 410       begin
 411          Write_Eol;
 412
 413          while Col > Column loop
 414             Write_Char ('-');
 415          end loop;
 416
 417          Write_Eol;
 418       end Underline;
 419
 420    --  Start of processing for Tree_Dump.
 421
 422    begin
 423       Dump_Generated_Only := Debug_Flag_G or
 424                              Print_Generated_Code or
 425                              Debug_Generated_Code;
 426       Dump_Original_Only  := Debug_Flag_O;
 427       Dump_Freeze_Null    := Debug_Flag_S or Debug_Flag_G;
 428
 429       --  Note that we turn off the tree dump flags immediately, before
 430       --  starting the dump. This avoids generating two copies of the dump
 431       --  if an abort occurs after printing the dump, and more importantly,
 432       --  avoids an infinite loop if an abort occurs during the dump.
 433
 434       if Debug_Flag_Z then
 435          Debug_Flag_Z := False;
 436          Write_Eol;
 437          Write_Eol;
 438          Write_Str ("Source recreated from tree of Standard (spec)");
 439          Underline;
 440          Sprint_Node (Standard_Package_Node);
 441          Write_Eol;
 442          Write_Eol;
 443       end if;
 444
 445       if Debug_Flag_S or Dump_Generated_Only or Dump_Original_Only then
 446          Debug_Flag_G := False;
 447          Debug_Flag_O := False;
 448          Debug_Flag_S := False;
 449
 450          --  Dump requested units
 451
 452          for U in Main_Unit .. Last_Unit loop
 453
 454             --  Dump all units if -gnatdf set, otherwise we dump only
 455             --  the source files that are in the extended main source.
 456
 457             if Debug_Flag_F
 458               or else In_Extended_Main_Source_Unit (Cunit_Entity (U))
 459             then
 460                --  If we are generating debug files, setup to write them
 461
 462                if Debug_Generated_Code then
 463                   Set_Special_Output (Print_Debug_Line'Access);
 464                   Create_Debug_Source (Source_Index (U), Debug_Sloc);
 465                   Sprint_Node (Cunit (U));
 466                   Write_Eol;
 467                   Close_Debug_Source;
 468                   Set_Special_Output (null);
 469
 470                --  Normal output to standard output file
 471
 472                else
 473                   Write_Str ("Source recreated from tree for ");
 474                   Write_Unit_Name (Unit_Name (U));
 475                   Underline;
 476                   Sprint_Node (Cunit (U));
 477                   Write_Eol;
 478                   Write_Eol;
 479                end if;
 480             end if;
 481          end loop;
 482       end if;
 483    end Source_Dump;
 484
 485    ---------------------
 486    -- Sprint_And_List --
 487    ---------------------
 488
 489    procedure Sprint_And_List (List : List_Id) is
 490       Node : Node_Id;
 491    begin
 492       if Is_Non_Empty_List (List) then
 493          Node := First (List);
 494          loop
 495             Sprint_Node (Node);
 496             Next (Node);
 497             exit when Node = Empty;
 498             Write_Str (" and ");
 499          end loop;
 500       end if;
 501    end Sprint_And_List;
 502
 503    ---------------------
 504    -- Sprint_Bar_List --
 505    ---------------------
 506
 507    procedure Sprint_Bar_List (List : List_Id) is
 508       Node : Node_Id;
 509    begin
 510       if Is_Non_Empty_List (List) then
 511          Node := First (List);
 512          loop
 513             Sprint_Node (Node);
 514             Next (Node);
 515             exit when Node = Empty;
 516             Write_Str (" | ");
 517          end loop;
 518       end if;
 519    end Sprint_Bar_List;
 520
 521    -----------------------
 522    -- Sprint_Comma_List --
 523    -----------------------
 524
 525    procedure Sprint_Comma_List (List : List_Id) is
 526       Node : Node_Id;
 527
 528    begin
 529       if Is_Non_Empty_List (List) then
 530          Node := First (List);
 531          loop
 532             Sprint_Node (Node);
 533             Next (Node);
 534             exit when Node = Empty;
 535
 536             if not Is_Rewrite_Insertion (Node)
 537               or else not Dump_Original_Only
 538             then
 539                Write_Str (", ");
 540             end if;
 541          end loop;
 542       end if;
 543    end Sprint_Comma_List;
 544
 545    --------------------------
 546    -- Sprint_Indented_List --
 547    --------------------------
 548
 549    procedure Sprint_Indented_List (List : List_Id) is
 550    begin
 551       Indent_Begin;
 552       Sprint_Node_List (List);
 553       Indent_End;
 554    end Sprint_Indented_List;
 555
 556    ---------------------
 557    -- Sprint_Left_Opnd --
 558    ---------------------
 559
 560    procedure Sprint_Left_Opnd (N : Node_Id) is
 561       Opnd : constant Node_Id := Left_Opnd (N);
 562
 563    begin
 564       if Paren_Count (Opnd) /= 0
 565         or else Op_Prec (Nkind (Opnd)) >= Op_Prec (Nkind (N))
 566       then
 567          Sprint_Node (Opnd);
 568
 569       else
 570          Write_Char ('(');
 571          Sprint_Node (Opnd);
 572          Write_Char (')');
 573       end if;
 574    end Sprint_Left_Opnd;
 575
 576    -----------------
 577    -- Sprint_Node --
 578    -----------------
 579
 580    procedure Sprint_Node (Node : Node_Id) is
 581    begin
 582       if Is_Rewrite_Insertion (Node) then
 583          if not Dump_Original_Only then
 584
 585             --  For special cases of nodes that always output <<< >>>
 586             --  do not duplicate the output at this point.
 587
 588             if Nkind (Node) = N_Freeze_Entity
 589               or else Nkind (Node) = N_Implicit_Label_Declaration
 590             then
 591                Sprint_Node_Actual (Node);
 592
 593             --  Normal case where <<< >>> may be required
 594
 595             else
 596                Write_Rewrite_Str ("<<<");
 597                Sprint_Node_Actual (Node);
 598                Write_Rewrite_Str (">>>");
 599             end if;
 600          end if;
 601
 602       elsif Is_Rewrite_Substitution (Node) then
 603
 604          --  Case of dump generated only
 605
 606          if Dump_Generated_Only then
 607             Sprint_Node_Actual (Node);
 608
 609          --  Case of dump original only
 610
 611          elsif Dump_Original_Only then
 612             Sprint_Node_Actual (Original_Node (Node));
 613
 614          --  Case of both being dumped
 615
 616          else
 617             Sprint_Node_Actual (Original_Node (Node));
 618             Write_Rewrite_Str ("<<<");
 619             Sprint_Node_Actual (Node);
 620             Write_Rewrite_Str (">>>");
 621          end if;
 622
 623       else
 624          Sprint_Node_Actual (Node);
 625       end if;
 626    end Sprint_Node;
 627
 628    ------------------------
 629    -- Sprint_Node_Actual --
 630    ------------------------
 631
 632    procedure Sprint_Node_Actual (Node : Node_Id) is
 633       Save_Debug_Node : constant Node_Id := Debug_Node;
 634
 635    begin
 636       if Node = Empty then
 637          return;
 638       end if;
 639
 640       for J in 1 .. Paren_Count (Node) loop
 641          Write_Str_With_Col_Check ("(");
 642       end loop;
 643
 644       --  Setup node for Sloc fixup if writing a debug source file. Note
 645       --  that we take care of any previous node not yet properly set.
 646
 647       if Debug_Generated_Code then
 648          Debug_Node := Node;
 649       end if;
 650
 651       if Nkind (Node) in N_Subexpr
 652         and then Do_Range_Check (Node)
 653       then
 654          Write_Str_With_Col_Check ("{");
 655       end if;
 656
 657       --  Select print circuit based on node kind
 658
 659       case Nkind (Node) is
 660
 661          when N_Abort_Statement =>
 662             Write_Indent_Str_Sloc ("abort ");
 663             Sprint_Comma_List (Names (Node));
 664             Write_Char (';');
 665
 666          when N_Abortable_Part =>
 667             Set_Debug_Sloc;
 668             Write_Str_Sloc ("abort ");
 669             Sprint_Indented_List (Statements (Node));
 670
 671          when N_Abstract_Subprogram_Declaration =>
 672             Write_Indent;
 673             Sprint_Node (Specification (Node));
 674             Write_Str_With_Col_Check (" is ");
 675             Write_Str_Sloc ("abstract;");
 676
 677          when N_Accept_Alternative =>
 678             Sprint_Node_List (Pragmas_Before (Node));
 679
 680             if Present (Condition (Node)) then
 681                Write_Indent_Str ("when ");
 682                Sprint_Node (Condition (Node));
 683                Write_Str (" => ");
 684                Indent_Annull;
 685             end if;
 686
 687             Sprint_Node_Sloc (Accept_Statement (Node));
 688             Sprint_Node_List (Statements (Node));
 689
 690          when N_Accept_Statement =>
 691             Write_Indent_Str_Sloc ("accept ");
 692             Write_Id (Entry_Direct_Name (Node));
 693
 694             if Present (Entry_Index (Node)) then
 695                Write_Str_With_Col_Check (" (");
 696                Sprint_Node (Entry_Index (Node));
 697                Write_Char (')');
 698             end if;
 699
 700             Write_Param_Specs (Node);
 701
 702             if Present (Handled_Statement_Sequence (Node)) then
 703                Write_Str_With_Col_Check (" do");
 704                Sprint_Node (Handled_Statement_Sequence (Node));
 705                Write_Indent_Str ("end ");
 706                Write_Id (Entry_Direct_Name (Node));
 707             end if;
 708
 709             Write_Char (';');
 710
 711          when N_Access_Definition =>
 712
 713             --  Ada 2005 (AI-254)
 714
 715             if Present (Access_To_Subprogram_Definition (Node)) then
 716                Sprint_Node (Access_To_Subprogram_Definition (Node));
 717             else
 718                --  Ada 2005 (AI-231)
 719
 720                if Null_Exclusion_Present (Node) then
 721                   Write_Str ("not null ");
 722                end if;
 723
 724                Write_Str_With_Col_Check_Sloc ("access ");
 725
 726                if All_Present (Node) then
 727                   Write_Str ("all ");
 728                elsif Constant_Present (Node) then
 729                   Write_Str ("constant ");
 730                end if;
 731
 732                Sprint_Node (Subtype_Mark (Node));
 733             end if;
 734
 735          when N_Access_Function_Definition =>
 736
 737             --  Ada 2005 (AI-231)
 738
 739             if Null_Exclusion_Present (Node) then
 740                Write_Str ("not null ");
 741             end if;
 742
 743             Write_Str_With_Col_Check_Sloc ("access ");
 744
 745             if Protected_Present (Node) then
 746                Write_Str_With_Col_Check ("protected ");
 747             end if;
 748
 749             Write_Str_With_Col_Check ("function");
 750             Write_Param_Specs (Node);
 751             Write_Str_With_Col_Check (" return ");
 752             Sprint_Node (Subtype_Mark (Node));
 753
 754          when N_Access_Procedure_Definition =>
 755
 756             --  Ada 2005 (AI-231)
 757
 758             if Null_Exclusion_Present (Node) then
 759                Write_Str ("not null ");
 760             end if;
 761
 762             Write_Str_With_Col_Check_Sloc ("access ");
 763
 764             if Protected_Present (Node) then
 765                Write_Str_With_Col_Check ("protected ");
 766             end if;
 767
 768             Write_Str_With_Col_Check ("procedure");
 769             Write_Param_Specs (Node);
 770
 771          when N_Access_To_Object_Definition =>
 772             Write_Str_With_Col_Check_Sloc ("access ");
 773
 774             if All_Present (Node) then
 775                Write_Str_With_Col_Check ("all ");
 776             elsif Constant_Present (Node) then
 777                Write_Str_With_Col_Check ("constant ");
 778             end if;
 779
 780             --  Ada 2005 (AI-231)
 781
 782             if Null_Exclusion_Present (Node) then
 783                Write_Str ("not null ");
 784             end if;
 785
 786             Sprint_Node (Subtype_Indication (Node));
 787
 788          when N_Aggregate =>
 789             if Null_Record_Present (Node) then
 790                Write_Str_With_Col_Check_Sloc ("(null record)");
 791
 792             else
 793                Write_Str_With_Col_Check_Sloc ("(");
 794
 795                if Present (Expressions (Node)) then
 796                   Sprint_Comma_List (Expressions (Node));
 797
 798                   if Present (Component_Associations (Node)) then
 799                      Write_Str (", ");
 800                   end if;
 801                end if;
 802
 803                if Present (Component_Associations (Node)) then
 804                   Indent_Begin;
 805
 806                   declare
 807                      Nd : Node_Id;
 808
 809                   begin
 810                      Nd := First (Component_Associations (Node));
 811
 812                      loop
 813                         Write_Indent;
 814                         Sprint_Node (Nd);
 815                         Next (Nd);
 816                         exit when No (Nd);
 817
 818                         if not Is_Rewrite_Insertion (Nd)
 819                           or else not Dump_Original_Only
 820                         then
 821                            Write_Str (", ");
 822                         end if;
 823                      end loop;
 824                   end;
 825
 826                   Indent_End;
 827                end if;
 828
 829                Write_Char (')');
 830             end if;
 831
 832          when N_Allocator =>
 833             Write_Str_With_Col_Check_Sloc ("new ");
 834
 835             --  Ada 2005 (AI-231)
 836
 837             if Null_Exclusion_Present (Node) then
 838                Write_Str ("not null ");
 839             end if;
 840
 841             Sprint_Node (Expression (Node));
 842
 843             if Present (Storage_Pool (Node)) then
 844                Write_Str_With_Col_Check ("[storage_pool = ");
 845                Sprint_Node (Storage_Pool (Node));
 846                Write_Char (']');
 847             end if;
 848
 849          when N_And_Then =>
 850             Sprint_Left_Opnd (Node);
 851             Write_Str_Sloc (" and then ");
 852             Sprint_Right_Opnd (Node);
 853
 854          when N_At_Clause =>
 855             Write_Indent_Str_Sloc ("for ");
 856             Write_Id (Identifier (Node));
 857             Write_Str_With_Col_Check (" use at ");
 858             Sprint_Node (Expression (Node));
 859             Write_Char (';');
 860
 861          when N_Assignment_Statement =>
 862             Write_Indent;
 863             Sprint_Node (Name (Node));
 864             Write_Str_Sloc (" := ");
 865             Sprint_Node (Expression (Node));
 866             Write_Char (';');
 867
 868          when N_Asynchronous_Select =>
 869             Write_Indent_Str_Sloc ("select");
 870             Indent_Begin;
 871             Sprint_Node (Triggering_Alternative (Node));
 872             Indent_End;
 873
 874             --  Note: let the printing of Abortable_Part handle outputting
 875             --  the ABORT keyword, so that the Slco can be set correctly.
 876
 877             Write_Indent_Str ("then ");
 878             Sprint_Node (Abortable_Part (Node));
 879             Write_Indent_Str ("end select;");
 880
 881          when N_Attribute_Definition_Clause =>
 882             Write_Indent_Str_Sloc ("for ");
 883             Sprint_Node (Name (Node));
 884             Write_Char (''');
 885             Write_Name_With_Col_Check (Chars (Node));
 886             Write_Str_With_Col_Check (" use ");
 887             Sprint_Node (Expression (Node));
 888             Write_Char (';');
 889
 890          when N_Attribute_Reference =>
 891             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
 892                Write_Indent;
 893             end if;
 894
 895             Sprint_Node (Prefix (Node));
 896             Write_Char_Sloc (''');
 897             Write_Name_With_Col_Check (Attribute_Name (Node));
 898             Sprint_Paren_Comma_List (Expressions (Node));
 899
 900             if Is_Procedure_Attribute_Name (Attribute_Name (Node)) then
 901                Write_Char (';');
 902             end if;
 903
 904          when N_Block_Statement =>
 905             Write_Indent;
 906
 907             if Present (Identifier (Node))
 908               and then (not Has_Created_Identifier (Node)
 909                           or else not Dump_Original_Only)
 910             then
 911                Write_Rewrite_Str ("<<<");
 912                Write_Id (Identifier (Node));
 913                Write_Str (" : ");
 914                Write_Rewrite_Str (">>>");
 915             end if;
 916
 917             if Present (Declarations (Node)) then
 918                Write_Str_With_Col_Check_Sloc ("declare");
 919                Sprint_Indented_List (Declarations (Node));
 920                Write_Indent;
 921             end if;
 922
 923             Write_Str_With_Col_Check_Sloc ("begin");
 924             Sprint_Node (Handled_Statement_Sequence (Node));
 925             Write_Indent_Str ("end");
 926
 927             if Present (Identifier (Node))
 928               and then (not Has_Created_Identifier (Node)
 929                           or else not Dump_Original_Only)
 930             then
 931                Write_Rewrite_Str ("<<<");
 932                Write_Char (' ');
 933                Write_Id (Identifier (Node));
 934                Write_Rewrite_Str (">>>");
 935             end if;
 936
 937             Write_Char (';');
 938
 939          when N_Case_Statement =>
 940             Write_Indent_Str_Sloc ("case ");
 941             Sprint_Node (Expression (Node));
 942             Write_Str (" is");
 943             Sprint_Indented_List (Alternatives (Node));
 944             Write_Indent_Str ("end case;");
 945
 946          when N_Case_Statement_Alternative =>
 947             Write_Indent_Str_Sloc ("when ");
 948             Sprint_Bar_List (Discrete_Choices (Node));
 949             Write_Str (" => ");
 950             Sprint_Indented_List (Statements (Node));
 951
 952          when N_Character_Literal =>
 953             if Column > 70 then
 954                Write_Indent_Str ("  ");
 955             end if;
 956
 957             Write_Char_Sloc (''');
 958             Write_Char_Code (UI_To_CC (Char_Literal_Value (Node)));
 959             Write_Char (''');
 960
 961          when N_Code_Statement =>
 962             Write_Indent;
 963             Set_Debug_Sloc;
 964             Sprint_Node (Expression (Node));
 965             Write_Char (';');
 966
 967          when N_Compilation_Unit =>
 968             Sprint_Node_List (Context_Items (Node));
 969             Sprint_Opt_Node_List (Declarations (Aux_Decls_Node (Node)));
 970
 971             if Private_Present (Node) then
 972                Write_Indent_Str ("private ");
 973                Indent_Annull;
 974             end if;
 975
 976             Sprint_Node_Sloc (Unit (Node));
 977
 978             if Present (Actions (Aux_Decls_Node (Node)))
 979                  or else
 980                Present (Pragmas_After (Aux_Decls_Node (Node)))
 981             then
 982                Write_Indent;
 983             end if;
 984
 985             Sprint_Opt_Node_List (Actions (Aux_Decls_Node (Node)));
 986             Sprint_Opt_Node_List (Pragmas_After (Aux_Decls_Node (Node)));
 987
 988          when N_Compilation_Unit_Aux =>
 989             null; -- nothing to do, never used, see above
 990
 991          when N_Component_Association =>
 992             Set_Debug_Sloc;
 993             Sprint_Bar_List (Choices (Node));
 994             Write_Str (" => ");
 995
 996             --  Ada 2005 (AI-287): Print the mbox if present
 997
 998             if Box_Present (Node) then
 999                Write_Str_With_Col_Check ("<>");
1000             else
1001                Sprint_Node (Expression (Node));
1002             end if;
1003
1004          when N_Component_Clause =>
1005             Write_Indent;
1006             Sprint_Node (Component_Name (Node));
1007             Write_Str_Sloc (" at ");
1008             Sprint_Node (Position (Node));
1009             Write_Char (' ');
1010             Write_Str_With_Col_Check ("range ");
1011             Sprint_Node (First_Bit (Node));
1012             Write_Str (" .. ");
1013             Sprint_Node (Last_Bit (Node));
1014             Write_Char (';');
1015
1016          when N_Component_Definition =>
1017             Set_Debug_Sloc;
1018
1019             --  Ada 2005 (AI-230): Access definition components
1020
1021             if Present (Access_Definition (Node)) then
1022                Sprint_Node (Access_Definition (Node));
1023
1024             elsif Present (Subtype_Indication (Node)) then
1025                if Aliased_Present (Node) then
1026                   Write_Str_With_Col_Check ("aliased ");
1027                end if;
1028
1029                --  Ada 2005 (AI-231)
1030
1031                if Null_Exclusion_Present (Node) then
1032                   Write_Str (" not null ");
1033                end if;
1034
1035                Sprint_Node (Subtype_Indication (Node));
1036
1037             else
1038                Write_Str (" ??? ");
1039             end if;
1040
1041          when N_Component_Declaration =>
1042             if Write_Indent_Identifiers_Sloc (Node) then
1043                Write_Str (" : ");
1044                Sprint_Node (Component_Definition (Node));
1045
1046                if Present (Expression (Node)) then
1047                   Write_Str (" := ");
1048                   Sprint_Node (Expression (Node));
1049                end if;
1050
1051                Write_Char (';');
1052             end if;
1053
1054          when N_Component_List =>
1055             if Null_Present (Node) then
1056                Indent_Begin;
1057                Write_Indent_Str_Sloc ("null");
1058                Write_Char (';');
1059                Indent_End;
1060
1061             else
1062                Set_Debug_Sloc;
1063                Sprint_Indented_List (Component_Items (Node));
1064                Sprint_Node (Variant_Part (Node));
1065             end if;
1066
1067          when N_Conditional_Entry_Call =>
1068             Write_Indent_Str_Sloc ("select");
1069             Indent_Begin;
1070             Sprint_Node (Entry_Call_Alternative (Node));
1071             Indent_End;
1072             Write_Indent_Str ("else");
1073             Sprint_Indented_List (Else_Statements (Node));
1074             Write_Indent_Str ("end select;");
1075
1076          when N_Conditional_Expression =>
1077             declare
1078                Condition : constant Node_Id := First (Expressions (Node));
1079                Then_Expr : constant Node_Id := Next (Condition);
1080                Else_Expr : constant Node_Id := Next (Then_Expr);
1081
1082             begin
1083                Write_Str_With_Col_Check_Sloc ("(if ");
1084                Sprint_Node (Condition);
1085                Write_Str_With_Col_Check (" then ");
1086                Sprint_Node (Then_Expr);
1087                Write_Str_With_Col_Check (" else ");
1088                Sprint_Node (Else_Expr);
1089                Write_Char (')');
1090             end;
1091
1092          when N_Constrained_Array_Definition =>
1093             Write_Str_With_Col_Check_Sloc ("array ");
1094             Sprint_Paren_Comma_List (Discrete_Subtype_Definitions (Node));
1095             Write_Str (" of ");
1096
1097             Sprint_Node (Component_Definition (Node));
1098
1099          when N_Decimal_Fixed_Point_Definition =>
1100             Write_Str_With_Col_Check_Sloc (" delta ");
1101             Sprint_Node (Delta_Expression (Node));
1102             Write_Str_With_Col_Check ("digits ");
1103             Sprint_Node (Digits_Expression (Node));
1104             Sprint_Opt_Node (Real_Range_Specification (Node));
1105
1106          when N_Defining_Character_Literal =>
1107             Write_Name_With_Col_Check_Sloc (Chars (Node));
1108
1109          when N_Defining_Identifier =>
1110             Set_Debug_Sloc;
1111             Write_Id (Node);
1112
1113          when N_Defining_Operator_Symbol =>
1114             Write_Name_With_Col_Check_Sloc (Chars (Node));
1115
1116          when N_Defining_Program_Unit_Name =>
1117             Set_Debug_Sloc;
1118             Sprint_Node (Name (Node));
1119             Write_Char ('.');
1120             Write_Id (Defining_Identifier (Node));
1121
1122          when N_Delay_Alternative =>
1123             Sprint_Node_List (Pragmas_Before (Node));
1124
1125             if Present (Condition (Node)) then
1126                Write_Indent;
1127                Write_Str_With_Col_Check ("when ");
1128                Sprint_Node (Condition (Node));
1129                Write_Str (" => ");
1130                Indent_Annull;
1131             end if;
1132
1133             Sprint_Node_Sloc (Delay_Statement (Node));
1134             Sprint_Node_List (Statements (Node));
1135
1136          when N_Delay_Relative_Statement =>
1137             Write_Indent_Str_Sloc ("delay ");
1138             Sprint_Node (Expression (Node));
1139             Write_Char (';');
1140
1141          when N_Delay_Until_Statement =>
1142             Write_Indent_Str_Sloc ("delay until ");
1143             Sprint_Node (Expression (Node));
1144             Write_Char (';');
1145
1146          when N_Delta_Constraint =>
1147             Write_Str_With_Col_Check_Sloc ("delta ");
1148             Sprint_Node (Delta_Expression (Node));
1149             Sprint_Opt_Node (Range_Constraint (Node));
1150
1151          when N_Derived_Type_Definition =>
1152             if Abstract_Present (Node) then
1153                Write_Str_With_Col_Check ("abstract ");
1154             end if;
1155
1156             Write_Str_With_Col_Check_Sloc ("new ");
1157
1158             --  Ada 2005 (AI-231)
1159
1160             if Null_Exclusion_Present (Node) then
1161                Write_Str_With_Col_Check ("not null ");
1162             end if;
1163
1164             Sprint_Node (Subtype_Indication (Node));
1165
1166             if Present (Interface_List (Node)) then
1167                Sprint_And_List (Interface_List (Node));
1168                Write_Str_With_Col_Check (" with ");
1169             end if;
1170
1171             if Present (Record_Extension_Part (Node)) then
1172                if No (Interface_List (Node)) then
1173                   Write_Str_With_Col_Check (" with ");
1174                end if;
1175
1176                Sprint_Node (Record_Extension_Part (Node));
1177             end if;
1178
1179          when N_Designator =>
1180             Sprint_Node (Name (Node));
1181             Write_Char_Sloc ('.');
1182             Write_Id (Identifier (Node));
1183
1184          when N_Digits_Constraint =>
1185             Write_Str_With_Col_Check_Sloc ("digits ");
1186             Sprint_Node (Digits_Expression (Node));
1187             Sprint_Opt_Node (Range_Constraint (Node));
1188
1189          when N_Discriminant_Association =>
1190             Set_Debug_Sloc;
1191
1192             if Present (Selector_Names (Node)) then
1193                Sprint_Bar_List (Selector_Names (Node));
1194                Write_Str (" => ");
1195             end if;
1196
1197             Set_Debug_Sloc;
1198             Sprint_Node (Expression (Node));
1199
1200          when N_Discriminant_Specification =>
1201             Set_Debug_Sloc;
1202
1203             if Write_Identifiers (Node) then
1204                Write_Str (" : ");
1205
1206                if Null_Exclusion_Present (Node) then
1207                   Write_Str ("not null ");
1208                end if;
1209
1210                Sprint_Node (Discriminant_Type (Node));
1211
1212                if Present (Expression (Node)) then
1213                   Write_Str (" := ");
1214                   Sprint_Node (Expression (Node));
1215                end if;
1216             else
1217                Write_Str (", ");
1218             end if;
1219
1220          when N_Elsif_Part =>
1221             Write_Indent_Str_Sloc ("elsif ");
1222             Sprint_Node (Condition (Node));
1223             Write_Str_With_Col_Check (" then");
1224             Sprint_Indented_List (Then_Statements (Node));
1225
1226          when N_Empty =>
1227             null;
1228
1229          when N_Entry_Body =>
1230             Write_Indent_Str_Sloc ("entry ");
1231             Write_Id (Defining_Identifier (Node));
1232             Sprint_Node (Entry_Body_Formal_Part (Node));
1233             Write_Str_With_Col_Check (" is");
1234             Sprint_Indented_List (Declarations (Node));
1235             Write_Indent_Str ("begin");
1236             Sprint_Node (Handled_Statement_Sequence (Node));
1237             Write_Indent_Str ("end ");
1238             Write_Id (Defining_Identifier (Node));
1239             Write_Char (';');
1240
1241          when N_Entry_Body_Formal_Part =>
1242             if Present (Entry_Index_Specification (Node)) then
1243                Write_Str_With_Col_Check_Sloc (" (");
1244                Sprint_Node (Entry_Index_Specification (Node));
1245                Write_Char (')');
1246             end if;
1247
1248             Write_Param_Specs (Node);
1249             Write_Str_With_Col_Check_Sloc (" when ");
1250             Sprint_Node (Condition (Node));
1251
1252          when N_Entry_Call_Alternative =>
1253             Sprint_Node_List (Pragmas_Before (Node));
1254             Sprint_Node_Sloc (Entry_Call_Statement (Node));
1255             Sprint_Node_List (Statements (Node));
1256
1257          when N_Entry_Call_Statement =>
1258             Write_Indent;
1259             Sprint_Node_Sloc (Name (Node));
1260             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1261             Write_Char (';');
1262
1263          when N_Entry_Declaration =>
1264             Write_Indent_Str_Sloc ("entry ");
1265             Write_Id (Defining_Identifier (Node));
1266
1267             if Present (Discrete_Subtype_Definition (Node)) then
1268                Write_Str_With_Col_Check (" (");
1269                Sprint_Node (Discrete_Subtype_Definition (Node));
1270                Write_Char (')');
1271             end if;
1272
1273             Write_Param_Specs (Node);
1274             Write_Char (';');
1275
1276          when N_Entry_Index_Specification =>
1277             Write_Str_With_Col_Check_Sloc ("for ");
1278             Write_Id (Defining_Identifier (Node));
1279             Write_Str_With_Col_Check (" in ");
1280             Sprint_Node (Discrete_Subtype_Definition (Node));
1281
1282          when N_Enumeration_Representation_Clause =>
1283             Write_Indent_Str_Sloc ("for ");
1284             Write_Id (Identifier (Node));
1285             Write_Str_With_Col_Check (" use ");
1286             Sprint_Node (Array_Aggregate (Node));
1287             Write_Char (';');
1288
1289          when N_Enumeration_Type_Definition =>
1290             Set_Debug_Sloc;
1291
1292             --  Skip attempt to print Literals field if it's not there and
1293             --  we are in package Standard (case of Character, which is
1294             --  handled specially (without an explicit literals list).
1295
1296             if Sloc (Node) > Standard_Location
1297               or else Present (Literals (Node))
1298             then
1299                Sprint_Paren_Comma_List (Literals (Node));
1300             end if;
1301
1302          when N_Error =>
1303             Write_Str_With_Col_Check_Sloc ("<error>");
1304
1305          when N_Exception_Declaration =>
1306             if Write_Indent_Identifiers (Node) then
1307                Write_Str_With_Col_Check (" : ");
1308                Write_Str_Sloc ("exception;");
1309             end if;
1310
1311          when N_Exception_Handler =>
1312             Write_Indent_Str_Sloc ("when ");
1313
1314             if Present (Choice_Parameter (Node)) then
1315                Sprint_Node (Choice_Parameter (Node));
1316                Write_Str (" : ");
1317             end if;
1318
1319             Sprint_Bar_List (Exception_Choices (Node));
1320             Write_Str (" => ");
1321             Sprint_Indented_List (Statements (Node));
1322
1323          when N_Exception_Renaming_Declaration =>
1324             Write_Indent;
1325             Set_Debug_Sloc;
1326             Sprint_Node (Defining_Identifier (Node));
1327             Write_Str_With_Col_Check (" : exception renames ");
1328             Sprint_Node (Name (Node));
1329             Write_Char (';');
1330
1331          when N_Exit_Statement =>
1332             Write_Indent_Str_Sloc ("exit");
1333             Sprint_Opt_Node (Name (Node));
1334
1335             if Present (Condition (Node)) then
1336                Write_Str_With_Col_Check (" when ");
1337                Sprint_Node (Condition (Node));
1338             end if;
1339
1340             Write_Char (';');
1341
1342          when N_Expanded_Name =>
1343             Sprint_Node (Prefix (Node));
1344             Write_Char_Sloc ('.');
1345             Sprint_Node (Selector_Name (Node));
1346
1347          when N_Explicit_Dereference =>
1348             Sprint_Node (Prefix (Node));
1349             Write_Char_Sloc ('.');
1350             Write_Str_Sloc ("all");
1351
1352          when N_Extension_Aggregate =>
1353             Write_Str_With_Col_Check_Sloc ("(");
1354             Sprint_Node (Ancestor_Part (Node));
1355             Write_Str_With_Col_Check (" with ");
1356
1357             if Null_Record_Present (Node) then
1358                Write_Str_With_Col_Check ("null record");
1359             else
1360                if Present (Expressions (Node)) then
1361                   Sprint_Comma_List (Expressions (Node));
1362
1363                   if Present (Component_Associations (Node)) then
1364                      Write_Str (", ");
1365                   end if;
1366                end if;
1367
1368                if Present (Component_Associations (Node)) then
1369                   Sprint_Comma_List (Component_Associations (Node));
1370                end if;
1371             end if;
1372
1373             Write_Char (')');
1374
1375          when N_Floating_Point_Definition =>
1376             Write_Str_With_Col_Check_Sloc ("digits ");
1377             Sprint_Node (Digits_Expression (Node));
1378             Sprint_Opt_Node (Real_Range_Specification (Node));
1379
1380          when N_Formal_Decimal_Fixed_Point_Definition =>
1381             Write_Str_With_Col_Check_Sloc ("delta <> digits <>");
1382
1383          when N_Formal_Derived_Type_Definition =>
1384             Write_Str_With_Col_Check_Sloc ("new ");
1385             Sprint_Node (Subtype_Mark (Node));
1386
1387             if Private_Present (Node) then
1388                Write_Str_With_Col_Check (" with private");
1389             end if;
1390
1391          when N_Formal_Abstract_Subprogram_Declaration =>
1392             Write_Indent_Str_Sloc ("with ");
1393             Sprint_Node (Specification (Node));
1394
1395             Write_Str_With_Col_Check (" is abstract");
1396
1397             if Box_Present (Node) then
1398                Write_Str_With_Col_Check (" <>");
1399             elsif Present (Default_Name (Node)) then
1400                Write_Str_With_Col_Check (" ");
1401                Sprint_Node (Default_Name (Node));
1402             end if;
1403
1404             Write_Char (';');
1405
1406          when N_Formal_Concrete_Subprogram_Declaration =>
1407             Write_Indent_Str_Sloc ("with ");
1408             Sprint_Node (Specification (Node));
1409
1410             if Box_Present (Node) then
1411                Write_Str_With_Col_Check (" is <>");
1412             elsif Present (Default_Name (Node)) then
1413                Write_Str_With_Col_Check (" is ");
1414                Sprint_Node (Default_Name (Node));
1415             end if;
1416
1417             Write_Char (';');
1418
1419          when N_Formal_Discrete_Type_Definition =>
1420             Write_Str_With_Col_Check_Sloc ("<>");
1421
1422          when N_Formal_Floating_Point_Definition =>
1423             Write_Str_With_Col_Check_Sloc ("digits <>");
1424
1425          when N_Formal_Modular_Type_Definition =>
1426             Write_Str_With_Col_Check_Sloc ("mod <>");
1427
1428          when N_Formal_Object_Declaration =>
1429             Set_Debug_Sloc;
1430
1431             if Write_Indent_Identifiers (Node) then
1432                Write_Str (" : ");
1433
1434                if In_Present (Node) then
1435                   Write_Str_With_Col_Check ("in ");
1436                end if;
1437
1438                if Out_Present (Node) then
1439                   Write_Str_With_Col_Check ("out ");
1440                end if;
1441
1442                Sprint_Node (Subtype_Mark (Node));
1443
1444                if Present (Expression (Node)) then
1445                   Write_Str (" := ");
1446                   Sprint_Node (Expression (Node));
1447                end if;
1448
1449                Write_Char (';');
1450             end if;
1451
1452          when N_Formal_Ordinary_Fixed_Point_Definition =>
1453             Write_Str_With_Col_Check_Sloc ("delta <>");
1454
1455          when N_Formal_Package_Declaration =>
1456             Write_Indent_Str_Sloc ("with package ");
1457             Write_Id (Defining_Identifier (Node));
1458             Write_Str_With_Col_Check (" is new ");
1459             Sprint_Node (Name (Node));
1460             Write_Str_With_Col_Check (" (<>);");
1461
1462          when N_Formal_Private_Type_Definition =>
1463             if Abstract_Present (Node) then
1464                Write_Str_With_Col_Check ("abstract ");
1465             end if;
1466
1467             if Tagged_Present (Node) then
1468                Write_Str_With_Col_Check ("tagged ");
1469             end if;
1470
1471             if Limited_Present (Node) then
1472                Write_Str_With_Col_Check ("limited ");
1473             end if;
1474
1475             Write_Str_With_Col_Check_Sloc ("private");
1476
1477          when N_Formal_Signed_Integer_Type_Definition =>
1478             Write_Str_With_Col_Check_Sloc ("range <>");
1479
1480          when N_Formal_Type_Declaration =>
1481             Write_Indent_Str_Sloc ("type ");
1482             Write_Id (Defining_Identifier (Node));
1483
1484             if Present (Discriminant_Specifications (Node)) then
1485                Write_Discr_Specs (Node);
1486             elsif Unknown_Discriminants_Present (Node) then
1487                Write_Str_With_Col_Check ("(<>)");
1488             end if;
1489
1490             Write_Str_With_Col_Check (" is ");
1491             Sprint_Node (Formal_Type_Definition (Node));
1492             Write_Char (';');
1493
1494          when N_Free_Statement =>
1495             Write_Indent_Str_Sloc ("free ");
1496             Sprint_Node (Expression (Node));
1497             Write_Char (';');
1498
1499          when N_Freeze_Entity =>
1500             if Dump_Original_Only then
1501                null;
1502
1503             elsif Present (Actions (Node)) or else Dump_Freeze_Null then
1504                Write_Indent;
1505                Write_Rewrite_Str ("<<<");
1506                Write_Str_With_Col_Check_Sloc ("freeze ");
1507                Write_Id (Entity (Node));
1508                Write_Str (" [");
1509
1510                if No (Actions (Node)) then
1511                   Write_Char (']');
1512
1513                else
1514                   Freeze_Indent := Freeze_Indent + 1;
1515                   Sprint_Indented_List (Actions (Node));
1516                   Freeze_Indent := Freeze_Indent - 1;
1517                   Write_Indent_Str ("]");
1518                end if;
1519
1520                Write_Rewrite_Str (">>>");
1521             end if;
1522
1523          when N_Full_Type_Declaration =>
1524             Write_Indent_Str_Sloc ("type ");
1525             Write_Id (Defining_Identifier (Node));
1526             Write_Discr_Specs (Node);
1527             Write_Str_With_Col_Check (" is ");
1528             Sprint_Node (Type_Definition (Node));
1529             Write_Char (';');
1530
1531          when N_Function_Call =>
1532             Set_Debug_Sloc;
1533             Sprint_Node (Name (Node));
1534             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
1535
1536          when N_Function_Instantiation =>
1537             Write_Indent_Str_Sloc ("function ");
1538             Sprint_Node (Defining_Unit_Name (Node));
1539             Write_Str_With_Col_Check (" is new ");
1540             Sprint_Node (Name (Node));
1541             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
1542             Write_Char (';');
1543
1544          when N_Function_Specification =>
1545             Write_Str_With_Col_Check_Sloc ("function ");
1546             Sprint_Node (Defining_Unit_Name (Node));
1547             Write_Param_Specs (Node);
1548             Write_Str_With_Col_Check (" return ");
1549             Sprint_Node (Subtype_Mark (Node));
1550
1551          when N_Generic_Association =>
1552             Set_Debug_Sloc;
1553
1554             if Present (Selector_Name (Node)) then
1555                Sprint_Node (Selector_Name (Node));
1556                Write_Str (" => ");
1557             end if;
1558
1559             Sprint_Node (Explicit_Generic_Actual_Parameter (Node));
1560
1561          when N_Generic_Function_Renaming_Declaration =>
1562             Write_Indent_Str_Sloc ("generic function ");
1563             Sprint_Node (Defining_Unit_Name (Node));
1564             Write_Str_With_Col_Check (" renames ");
1565             Sprint_Node (Name (Node));
1566             Write_Char (';');
1567
1568          when N_Generic_Package_Declaration =>
1569             Write_Indent;
1570             Write_Indent_Str_Sloc ("generic ");
1571             Sprint_Indented_List (Generic_Formal_Declarations (Node));
1572             Write_Indent;
1573             Sprint_Node (Specification (Node));
1574             Write_Char (';');
1575
1576          when N_Generic_Package_Renaming_Declaration =>
1577             Write_Indent_Str_Sloc ("generic package ");
1578             Sprint_Node (Defining_Unit_Name (Node));
1579             Write_Str_With_Col_Check (" renames ");
1580             Sprint_Node (Name (Node));
1581             Write_Char (';');
1582
1583          when N_Generic_Procedure_Renaming_Declaration =>
1584             Write_Indent_Str_Sloc ("generic procedure ");
1585             Sprint_Node (Defining_Unit_Name (Node));
1586             Write_Str_With_Col_Check (" renames ");
1587             Sprint_Node (Name (Node));
1588             Write_Char (';');
1589
1590          when N_Generic_Subprogram_Declaration =>
1591             Write_Indent;
1592             Write_Indent_Str_Sloc ("generic ");
1593             Sprint_Indented_List (Generic_Formal_Declarations (Node));
1594             Write_Indent;
1595             Sprint_Node (Specification (Node));
1596             Write_Char (';');
1597
1598          when N_Goto_Statement =>
1599             Write_Indent_Str_Sloc ("goto ");
1600             Sprint_Node (Name (Node));
1601             Write_Char (';');
1602
1603             if Nkind (Next (Node)) = N_Label then
1604                Write_Indent;
1605             end if;
1606
1607          when N_Handled_Sequence_Of_Statements =>
1608             Set_Debug_Sloc;
1609             Sprint_Indented_List (Statements (Node));
1610
1611             if Present (Exception_Handlers (Node)) then
1612                Write_Indent_Str ("exception");
1613                Indent_Begin;
1614                Sprint_Node_List (Exception_Handlers (Node));
1615                Indent_End;
1616             end if;
1617
1618             if Present (At_End_Proc (Node)) then
1619                Write_Indent_Str ("at end");
1620                Indent_Begin;
1621                Write_Indent;
1622                Sprint_Node (At_End_Proc (Node));
1623                Write_Char (';');
1624                Indent_End;
1625             end if;
1626
1627          when N_Identifier =>
1628             Set_Debug_Sloc;
1629             Write_Id (Node);
1630
1631          when N_If_Statement =>
1632             Write_Indent_Str_Sloc ("if ");
1633             Sprint_Node (Condition (Node));
1634             Write_Str_With_Col_Check (" then");
1635             Sprint_Indented_List (Then_Statements (Node));
1636             Sprint_Opt_Node_List (Elsif_Parts (Node));
1637
1638             if Present (Else_Statements (Node)) then
1639                Write_Indent_Str ("else");
1640                Sprint_Indented_List (Else_Statements (Node));
1641             end if;
1642
1643             Write_Indent_Str ("end if;");
1644
1645          when N_Implicit_Label_Declaration =>
1646             if not Dump_Original_Only then
1647                Write_Indent;
1648                Write_Rewrite_Str ("<<<");
1649                Set_Debug_Sloc;
1650                Write_Id (Defining_Identifier (Node));
1651                Write_Str (" : ");
1652                Write_Str_With_Col_Check ("label");
1653                Write_Rewrite_Str (">>>");
1654             end if;
1655
1656          when N_In =>
1657             Sprint_Left_Opnd (Node);
1658             Write_Str_Sloc (" in ");
1659             Sprint_Right_Opnd (Node);
1660
1661          when N_Incomplete_Type_Declaration =>
1662             Write_Indent_Str_Sloc ("type ");
1663             Write_Id (Defining_Identifier (Node));
1664
1665             if Present (Discriminant_Specifications (Node)) then
1666                Write_Discr_Specs (Node);
1667             elsif Unknown_Discriminants_Present (Node) then
1668                Write_Str_With_Col_Check ("(<>)");
1669             end if;
1670
1671             Write_Char (';');
1672
1673          when N_Index_Or_Discriminant_Constraint =>
1674             Set_Debug_Sloc;
1675             Sprint_Paren_Comma_List (Constraints (Node));
1676
1677          when N_Indexed_Component =>
1678             Sprint_Node_Sloc (Prefix (Node));
1679             Sprint_Opt_Paren_Comma_List (Expressions (Node));
1680
1681          when N_Integer_Literal =>
1682             if Print_In_Hex (Node) then
1683                Write_Uint_With_Col_Check_Sloc (Intval (Node), Hex);
1684             else
1685                Write_Uint_With_Col_Check_Sloc (Intval (Node), Auto);
1686             end if;
1687
1688          when N_Iteration_Scheme =>
1689             if Present (Condition (Node)) then
1690                Write_Str_With_Col_Check_Sloc ("while ");
1691                Sprint_Node (Condition (Node));
1692             else
1693                Write_Str_With_Col_Check_Sloc ("for ");
1694                Sprint_Node (Loop_Parameter_Specification (Node));
1695             end if;
1696
1697             Write_Char (' ');
1698
1699          when N_Itype_Reference =>
1700             Write_Indent_Str_Sloc ("reference ");
1701             Write_Id (Itype (Node));
1702
1703          when N_Label =>
1704             Write_Indent_Str_Sloc ("<<");
1705             Write_Id (Identifier (Node));
1706             Write_Str (">>");
1707
1708          when N_Loop_Parameter_Specification =>
1709             Set_Debug_Sloc;
1710             Write_Id (Defining_Identifier (Node));
1711             Write_Str_With_Col_Check (" in ");
1712
1713             if Reverse_Present (Node) then
1714                Write_Str_With_Col_Check ("reverse ");
1715             end if;
1716
1717             Sprint_Node (Discrete_Subtype_Definition (Node));
1718
1719          when N_Loop_Statement =>
1720             Write_Indent;
1721
1722             if Present (Identifier (Node))
1723               and then (not Has_Created_Identifier (Node)
1724                           or else not Dump_Original_Only)
1725             then
1726                Write_Rewrite_Str ("<<<");
1727                Write_Id (Identifier (Node));
1728                Write_Str (" : ");
1729                Write_Rewrite_Str (">>>");
1730                Sprint_Node (Iteration_Scheme (Node));
1731                Write_Str_With_Col_Check_Sloc ("loop");
1732                Sprint_Indented_List (Statements (Node));
1733                Write_Indent_Str ("end loop ");
1734                Write_Rewrite_Str ("<<<");
1735                Write_Id (Identifier (Node));
1736                Write_Rewrite_Str (">>>");
1737                Write_Char (';');
1738
1739             else
1740                Sprint_Node (Iteration_Scheme (Node));
1741                Write_Str_With_Col_Check_Sloc ("loop");
1742                Sprint_Indented_List (Statements (Node));
1743                Write_Indent_Str ("end loop;");
1744             end if;
1745
1746          when N_Mod_Clause =>
1747             Sprint_Node_List (Pragmas_Before (Node));
1748             Write_Str_With_Col_Check_Sloc ("at mod ");
1749             Sprint_Node (Expression (Node));
1750
1751          when N_Modular_Type_Definition =>
1752             Write_Str_With_Col_Check_Sloc ("mod ");
1753             Sprint_Node (Expression (Node));
1754
1755          when N_Not_In =>
1756             Sprint_Left_Opnd (Node);
1757             Write_Str_Sloc (" not in ");
1758             Sprint_Right_Opnd (Node);
1759
1760          when N_Null =>
1761             Write_Str_With_Col_Check_Sloc ("null");
1762
1763          when N_Null_Statement =>
1764             if Comes_From_Source (Node)
1765               or else Dump_Freeze_Null
1766               or else not Is_List_Member (Node)
1767               or else (No (Prev (Node)) and then No (Next (Node)))
1768             then
1769                Write_Indent_Str_Sloc ("null;");
1770             end if;
1771
1772          when N_Number_Declaration =>
1773             Set_Debug_Sloc;
1774
1775             if Write_Indent_Identifiers (Node) then
1776                Write_Str_With_Col_Check (" : constant ");
1777                Write_Str (" := ");
1778                Sprint_Node (Expression (Node));
1779                Write_Char (';');
1780             end if;
1781
1782          when N_Object_Declaration =>
1783             Set_Debug_Sloc;
1784
1785             if Write_Indent_Identifiers (Node) then
1786                Write_Str (" : ");
1787
1788                if Aliased_Present (Node) then
1789                   Write_Str_With_Col_Check ("aliased ");
1790                end if;
1791
1792                if Constant_Present (Node) then
1793                   Write_Str_With_Col_Check ("constant ");
1794                end if;
1795
1796                --  Ada 2005 (AI-231)
1797
1798                if Null_Exclusion_Present (Node) then
1799                   Write_Str_With_Col_Check ("not null ");
1800                end if;
1801
1802                Sprint_Node (Object_Definition (Node));
1803
1804                if Present (Expression (Node)) then
1805                   Write_Str (" := ");
1806                   Sprint_Node (Expression (Node));
1807                end if;
1808
1809                Write_Char (';');
1810             end if;
1811
1812          when N_Object_Renaming_Declaration =>
1813             Write_Indent;
1814             Set_Debug_Sloc;
1815             Sprint_Node (Defining_Identifier (Node));
1816             Write_Str (" : ");
1817
1818             --  Ada 2005 (AI-230): Access renamings
1819
1820             if Present (Access_Definition (Node)) then
1821                Sprint_Node (Access_Definition (Node));
1822
1823             elsif Present (Subtype_Mark (Node)) then
1824                Sprint_Node (Subtype_Mark (Node));
1825
1826             else
1827                Write_Str (" ??? ");
1828             end if;
1829
1830             Write_Str_With_Col_Check (" renames ");
1831             Sprint_Node (Name (Node));
1832             Write_Char (';');
1833
1834          when N_Op_Abs =>
1835             Write_Operator (Node, "abs ");
1836             Sprint_Right_Opnd (Node);
1837
1838          when N_Op_Add =>
1839             Sprint_Left_Opnd (Node);
1840             Write_Operator (Node, " + ");
1841             Sprint_Right_Opnd (Node);
1842
1843          when N_Op_And =>
1844             Sprint_Left_Opnd (Node);
1845             Write_Operator (Node, " and ");
1846             Sprint_Right_Opnd (Node);
1847
1848          when N_Op_Concat =>
1849             Sprint_Left_Opnd (Node);
1850             Write_Operator (Node, " & ");
1851             Sprint_Right_Opnd (Node);
1852
1853          when N_Op_Divide =>
1854             Sprint_Left_Opnd (Node);
1855             Write_Char (' ');
1856             Process_TFAI_RR_Flags (Node);
1857             Write_Operator (Node, "/ ");
1858             Sprint_Right_Opnd (Node);
1859
1860          when N_Op_Eq =>
1861             Sprint_Left_Opnd (Node);
1862             Write_Operator (Node, " = ");
1863             Sprint_Right_Opnd (Node);
1864
1865          when N_Op_Expon =>
1866             Sprint_Left_Opnd (Node);
1867             Write_Operator (Node, " ** ");
1868             Sprint_Right_Opnd (Node);
1869
1870          when N_Op_Ge =>
1871             Sprint_Left_Opnd (Node);
1872             Write_Operator (Node, " >= ");
1873             Sprint_Right_Opnd (Node);
1874
1875          when N_Op_Gt =>
1876             Sprint_Left_Opnd (Node);
1877             Write_Operator (Node, " > ");
1878             Sprint_Right_Opnd (Node);
1879
1880          when N_Op_Le =>
1881             Sprint_Left_Opnd (Node);
1882             Write_Operator (Node, " <= ");
1883             Sprint_Right_Opnd (Node);
1884
1885          when N_Op_Lt =>
1886             Sprint_Left_Opnd (Node);
1887             Write_Operator (Node, " < ");
1888             Sprint_Right_Opnd (Node);
1889
1890          when N_Op_Minus =>
1891             Write_Operator (Node, "-");
1892             Sprint_Right_Opnd (Node);
1893
1894          when N_Op_Mod =>
1895             Sprint_Left_Opnd (Node);
1896
1897             if Treat_Fixed_As_Integer (Node) then
1898                Write_Str (" #");
1899             end if;
1900
1901             Write_Operator (Node, " mod ");
1902             Sprint_Right_Opnd (Node);
1903
1904          when N_Op_Multiply =>
1905             Sprint_Left_Opnd (Node);
1906             Write_Char (' ');
1907             Process_TFAI_RR_Flags (Node);
1908             Write_Operator (Node, "* ");
1909             Sprint_Right_Opnd (Node);
1910
1911          when N_Op_Ne =>
1912             Sprint_Left_Opnd (Node);
1913             Write_Operator (Node, " /= ");
1914             Sprint_Right_Opnd (Node);
1915
1916          when N_Op_Not =>
1917             Write_Operator (Node, "not ");
1918             Sprint_Right_Opnd (Node);
1919
1920          when N_Op_Or =>
1921             Sprint_Left_Opnd (Node);
1922             Write_Operator (Node, " or ");
1923             Sprint_Right_Opnd (Node);
1924
1925          when N_Op_Plus =>
1926             Write_Operator (Node, "+");
1927             Sprint_Right_Opnd (Node);
1928
1929          when N_Op_Rem =>
1930             Sprint_Left_Opnd (Node);
1931
1932             if Treat_Fixed_As_Integer (Node) then
1933                Write_Str (" #");
1934             end if;
1935
1936             Write_Operator (Node, " rem ");
1937             Sprint_Right_Opnd (Node);
1938
1939          when N_Op_Shift =>
1940             Set_Debug_Sloc;
1941             Write_Id (Node);
1942             Write_Char ('!');
1943             Write_Str_With_Col_Check ("(");
1944             Sprint_Node (Left_Opnd (Node));
1945             Write_Str (", ");
1946             Sprint_Node (Right_Opnd (Node));
1947             Write_Char (')');
1948
1949          when N_Op_Subtract =>
1950             Sprint_Left_Opnd (Node);
1951             Write_Operator (Node, " - ");
1952             Sprint_Right_Opnd (Node);
1953
1954          when N_Op_Xor =>
1955             Sprint_Left_Opnd (Node);
1956             Write_Operator (Node, " xor ");
1957             Sprint_Right_Opnd (Node);
1958
1959          when N_Operator_Symbol =>
1960             Write_Name_With_Col_Check_Sloc (Chars (Node));
1961
1962          when N_Ordinary_Fixed_Point_Definition =>
1963             Write_Str_With_Col_Check_Sloc ("delta ");
1964             Sprint_Node (Delta_Expression (Node));
1965             Sprint_Opt_Node (Real_Range_Specification (Node));
1966
1967          when N_Or_Else =>
1968             Sprint_Left_Opnd (Node);
1969             Write_Str_Sloc (" or else ");
1970             Sprint_Right_Opnd (Node);
1971
1972          when N_Others_Choice =>
1973             if All_Others (Node) then
1974                Write_Str_With_Col_Check ("all ");
1975             end if;
1976
1977             Write_Str_With_Col_Check_Sloc ("others");
1978
1979          when N_Package_Body =>
1980             Write_Indent;
1981             Write_Indent_Str_Sloc ("package body ");
1982             Sprint_Node (Defining_Unit_Name (Node));
1983             Write_Str (" is");
1984             Sprint_Indented_List (Declarations (Node));
1985
1986             if Present (Handled_Statement_Sequence (Node)) then
1987                Write_Indent_Str ("begin");
1988                Sprint_Node (Handled_Statement_Sequence (Node));
1989             end if;
1990
1991             Write_Indent_Str ("end ");
1992             Sprint_Node (Defining_Unit_Name (Node));
1993             Write_Char (';');
1994
1995          when N_Package_Body_Stub =>
1996             Write_Indent_Str_Sloc ("package body ");
1997             Sprint_Node (Defining_Identifier (Node));
1998             Write_Str_With_Col_Check (" is separate;");
1999
2000          when N_Package_Declaration =>
2001             Write_Indent;
2002             Write_Indent;
2003             Sprint_Node_Sloc (Specification (Node));
2004             Write_Char (';');
2005
2006          when N_Package_Instantiation =>
2007             Write_Indent;
2008             Write_Indent_Str_Sloc ("package ");
2009             Sprint_Node (Defining_Unit_Name (Node));
2010             Write_Str (" is new ");
2011             Sprint_Node (Name (Node));
2012             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2013             Write_Char (';');
2014
2015          when N_Package_Renaming_Declaration =>
2016             Write_Indent_Str_Sloc ("package ");
2017             Sprint_Node (Defining_Unit_Name (Node));
2018             Write_Str_With_Col_Check (" renames ");
2019             Sprint_Node (Name (Node));
2020             Write_Char (';');
2021
2022          when N_Package_Specification =>
2023             Write_Str_With_Col_Check_Sloc ("package ");
2024             Sprint_Node (Defining_Unit_Name (Node));
2025             Write_Str (" is");
2026             Sprint_Indented_List (Visible_Declarations (Node));
2027
2028             if Present (Private_Declarations (Node)) then
2029                Write_Indent_Str ("private");
2030                Sprint_Indented_List (Private_Declarations (Node));
2031             end if;
2032
2033             Write_Indent_Str ("end ");
2034             Sprint_Node (Defining_Unit_Name (Node));
2035
2036          when N_Parameter_Association =>
2037             Sprint_Node_Sloc (Selector_Name (Node));
2038             Write_Str (" => ");
2039             Sprint_Node (Explicit_Actual_Parameter (Node));
2040
2041          when N_Parameter_Specification =>
2042             Set_Debug_Sloc;
2043
2044             if Write_Identifiers (Node) then
2045                Write_Str (" : ");
2046
2047                if In_Present (Node) then
2048                   Write_Str_With_Col_Check ("in ");
2049                end if;
2050
2051                if Out_Present (Node) then
2052                   Write_Str_With_Col_Check ("out ");
2053                end if;
2054
2055                --  Ada 2005 (AI-231)
2056
2057                if Null_Exclusion_Present (Node) then
2058                   Write_Str ("not null ");
2059                end if;
2060
2061                Sprint_Node (Parameter_Type (Node));
2062
2063                if Present (Expression (Node)) then
2064                   Write_Str (" := ");
2065                   Sprint_Node (Expression (Node));
2066                end if;
2067             else
2068                Write_Str (", ");
2069             end if;
2070
2071          when N_Pragma =>
2072             Write_Indent_Str_Sloc ("pragma ");
2073             Write_Name_With_Col_Check (Chars (Node));
2074
2075             if Present (Pragma_Argument_Associations (Node)) then
2076                Sprint_Opt_Paren_Comma_List
2077                  (Pragma_Argument_Associations (Node));
2078             end if;
2079
2080             Write_Char (';');
2081
2082          when N_Pragma_Argument_Association =>
2083             Set_Debug_Sloc;
2084
2085             if Chars (Node) /= No_Name then
2086                Write_Name_With_Col_Check (Chars (Node));
2087                Write_Str (" => ");
2088             end if;
2089
2090             Sprint_Node (Expression (Node));
2091
2092          when N_Private_Type_Declaration =>
2093             Write_Indent_Str_Sloc ("type ");
2094             Write_Id (Defining_Identifier (Node));
2095
2096             if Present (Discriminant_Specifications (Node)) then
2097                Write_Discr_Specs (Node);
2098             elsif Unknown_Discriminants_Present (Node) then
2099                Write_Str_With_Col_Check ("(<>)");
2100             end if;
2101
2102             Write_Str (" is ");
2103
2104             if Tagged_Present (Node) then
2105                Write_Str_With_Col_Check ("tagged ");
2106             end if;
2107
2108             if Limited_Present (Node) then
2109                Write_Str_With_Col_Check ("limited ");
2110             end if;
2111
2112             Write_Str_With_Col_Check ("private;");
2113
2114          when N_Private_Extension_Declaration =>
2115             Write_Indent_Str_Sloc ("type ");
2116             Write_Id (Defining_Identifier (Node));
2117
2118             if Present (Discriminant_Specifications (Node)) then
2119                Write_Discr_Specs (Node);
2120             elsif Unknown_Discriminants_Present (Node) then
2121                Write_Str_With_Col_Check ("(<>)");
2122             end if;
2123
2124             Write_Str_With_Col_Check (" is new ");
2125             Sprint_Node (Subtype_Indication (Node));
2126             Write_Str_With_Col_Check (" with private;");
2127
2128          when N_Procedure_Call_Statement =>
2129             Write_Indent;
2130             Set_Debug_Sloc;
2131             Sprint_Node (Name (Node));
2132             Sprint_Opt_Paren_Comma_List (Parameter_Associations (Node));
2133             Write_Char (';');
2134
2135          when N_Procedure_Instantiation =>
2136             Write_Indent_Str_Sloc ("procedure ");
2137             Sprint_Node (Defining_Unit_Name (Node));
2138             Write_Str_With_Col_Check (" is new ");
2139             Sprint_Node (Name (Node));
2140             Sprint_Opt_Paren_Comma_List (Generic_Associations (Node));
2141             Write_Char (';');
2142
2143          when N_Procedure_Specification =>
2144             Write_Str_With_Col_Check_Sloc ("procedure ");
2145             Sprint_Node (Defining_Unit_Name (Node));
2146             Write_Param_Specs (Node);
2147
2148          when N_Protected_Body =>
2149             Write_Indent_Str_Sloc ("protected body ");
2150             Write_Id (Defining_Identifier (Node));
2151             Write_Str (" is");
2152             Sprint_Indented_List (Declarations (Node));
2153             Write_Indent_Str ("end ");
2154             Write_Id (Defining_Identifier (Node));
2155             Write_Char (';');
2156
2157          when N_Protected_Body_Stub =>
2158             Write_Indent_Str_Sloc ("protected body ");
2159             Write_Id (Defining_Identifier (Node));
2160             Write_Str_With_Col_Check (" is separate;");
2161
2162          when N_Protected_Definition =>
2163             Set_Debug_Sloc;
2164             Sprint_Indented_List (Visible_Declarations (Node));
2165
2166             if Present (Private_Declarations (Node)) then
2167                Write_Indent_Str ("private");
2168                Sprint_Indented_List (Private_Declarations (Node));
2169             end if;
2170
2171             Write_Indent_Str ("end ");
2172
2173          when N_Protected_Type_Declaration =>
2174             Write_Indent_Str_Sloc ("protected type ");
2175             Write_Id (Defining_Identifier (Node));
2176             Write_Discr_Specs (Node);
2177
2178             if Present (Interface_List (Node)) then
2179                Write_Str (" is new ");
2180                Sprint_And_List (Interface_List (Node));
2181                Write_Str (" with ");
2182             else
2183                Write_Str (" is");
2184             end if;
2185
2186             Sprint_Node (Protected_Definition (Node));
2187             Write_Id (Defining_Identifier (Node));
2188             Write_Char (';');
2189
2190          when N_Qualified_Expression =>
2191             Sprint_Node (Subtype_Mark (Node));
2192             Write_Char_Sloc (''');
2193
2194             --  Print expression, make sure we have at least one level of
2195             --  parentheses around the expression. For cases of qualified
2196             --  expressions in the source, this is always the case, but
2197             --  for generated qualifications, there may be no explicit
2198             --  parentheses present.
2199
2200             if Paren_Count (Expression (Node)) /= 0 then
2201                Sprint_Node (Expression (Node));
2202             else
2203                Write_Char ('(');
2204                Sprint_Node (Expression (Node));
2205                Write_Char (')');
2206             end if;
2207
2208          when N_Raise_Constraint_Error =>
2209
2210             --  This node can be used either as a subexpression or as a
2211             --  statement form. The following test is a reasonably reliable
2212             --  way to distinguish the two cases.
2213
2214             if Is_List_Member (Node)
2215               and then Nkind (Parent (Node)) not in N_Subexpr
2216             then
2217                Write_Indent;
2218             end if;
2219
2220             Write_Str_With_Col_Check_Sloc ("[constraint_error");
2221             Write_Condition_And_Reason (Node);
2222
2223          when N_Raise_Program_Error =>
2224
2225             --  This node can be used either as a subexpression or as a
2226             --  statement form. The following test is a reasonably reliable
2227             --  way to distinguish the two cases.
2228
2229             if Is_List_Member (Node)
2230               and then Nkind (Parent (Node)) not in N_Subexpr
2231             then
2232                Write_Indent;
2233             end if;
2234
2235             Write_Str_With_Col_Check_Sloc ("[program_error");
2236             Write_Condition_And_Reason (Node);
2237
2238          when N_Raise_Storage_Error =>
2239
2240             --  This node can be used either as a subexpression or as a
2241             --  statement form. The following test is a reasonably reliable
2242             --  way to distinguish the two cases.
2243
2244             if Is_List_Member (Node)
2245               and then Nkind (Parent (Node)) not in N_Subexpr
2246             then
2247                Write_Indent;
2248             end if;
2249
2250             Write_Str_With_Col_Check_Sloc ("[storage_error");
2251             Write_Condition_And_Reason (Node);
2252
2253          when N_Raise_Statement =>
2254             Write_Indent_Str_Sloc ("raise ");
2255             Sprint_Node (Name (Node));
2256             Write_Char (';');
2257
2258          when N_Range =>
2259             Sprint_Node (Low_Bound (Node));
2260             Write_Str_Sloc (" .. ");
2261             Sprint_Node (High_Bound (Node));
2262
2263          when N_Range_Constraint =>
2264             Write_Str_With_Col_Check_Sloc ("range ");
2265             Sprint_Node (Range_Expression (Node));
2266
2267          when N_Real_Literal =>
2268             Write_Ureal_With_Col_Check_Sloc (Realval (Node));
2269
2270          when N_Real_Range_Specification =>
2271             Write_Str_With_Col_Check_Sloc ("range ");
2272             Sprint_Node (Low_Bound (Node));
2273             Write_Str (" .. ");
2274             Sprint_Node (High_Bound (Node));
2275
2276          when N_Record_Definition =>
2277             if Abstract_Present (Node) then
2278                Write_Str_With_Col_Check ("abstract ");
2279             end if;
2280
2281             if Tagged_Present (Node) then
2282                Write_Str_With_Col_Check ("tagged ");
2283             end if;
2284
2285             if Limited_Present (Node) then
2286                Write_Str_With_Col_Check ("limited ");
2287             end if;
2288
2289             if Null_Present (Node) then
2290                Write_Str_With_Col_Check_Sloc ("null record");
2291
2292             else
2293                Write_Str_With_Col_Check_Sloc ("record");
2294                Sprint_Node (Component_List (Node));
2295                Write_Indent_Str ("end record");
2296             end if;
2297
2298          when N_Record_Representation_Clause =>
2299             Write_Indent_Str_Sloc ("for ");
2300             Sprint_Node (Identifier (Node));
2301             Write_Str_With_Col_Check (" use record ");
2302
2303             if Present (Mod_Clause (Node)) then
2304                Sprint_Node (Mod_Clause (Node));
2305             end if;
2306
2307             Sprint_Indented_List (Component_Clauses (Node));
2308             Write_Indent_Str ("end record;");
2309
2310          when N_Reference =>
2311             Sprint_Node (Prefix (Node));
2312             Write_Str_With_Col_Check_Sloc ("'reference");
2313
2314          when N_Requeue_Statement =>
2315             Write_Indent_Str_Sloc ("requeue ");
2316             Sprint_Node (Name (Node));
2317
2318             if Abort_Present (Node) then
2319                Write_Str_With_Col_Check (" with abort");
2320             end if;
2321
2322             Write_Char (';');
2323
2324          when N_Return_Statement =>
2325             if Present (Expression (Node)) then
2326                Write_Indent_Str_Sloc ("return ");
2327                Sprint_Node (Expression (Node));
2328                Write_Char (';');
2329             else
2330                Write_Indent_Str_Sloc ("return;");
2331             end if;
2332
2333          when N_Selective_Accept =>
2334             Write_Indent_Str_Sloc ("select");
2335
2336             declare
2337                Alt_Node : Node_Id;
2338
2339             begin
2340                Alt_Node := First (Select_Alternatives (Node));
2341                loop
2342                   Indent_Begin;
2343                   Sprint_Node (Alt_Node);
2344                   Indent_End;
2345                   Next (Alt_Node);
2346                   exit when No (Alt_Node);
2347                   Write_Indent_Str ("or");
2348                end loop;
2349             end;
2350
2351             if Present (Else_Statements (Node)) then
2352                Write_Indent_Str ("else");
2353                Sprint_Indented_List (Else_Statements (Node));
2354             end if;
2355
2356             Write_Indent_Str ("end select;");
2357
2358          when N_Signed_Integer_Type_Definition =>
2359             Write_Str_With_Col_Check_Sloc ("range ");
2360             Sprint_Node (Low_Bound (Node));
2361             Write_Str (" .. ");
2362             Sprint_Node (High_Bound (Node));
2363
2364          when N_Single_Protected_Declaration =>
2365             Write_Indent_Str_Sloc ("protected ");
2366             Write_Id (Defining_Identifier (Node));
2367             Write_Str (" is");
2368             Sprint_Node (Protected_Definition (Node));
2369             Write_Id (Defining_Identifier (Node));
2370             Write_Char (';');
2371
2372          when N_Single_Task_Declaration =>
2373             Write_Indent_Str_Sloc ("task ");
2374             Write_Id (Defining_Identifier (Node));
2375
2376             if Present (Task_Definition (Node)) then
2377                Write_Str (" is");
2378                Sprint_Node (Task_Definition (Node));
2379                Write_Id (Defining_Identifier (Node));
2380             end if;
2381
2382             Write_Char (';');
2383
2384          when N_Selected_Component =>
2385             Sprint_Node (Prefix (Node));
2386             Write_Char_Sloc ('.');
2387             Sprint_Node (Selector_Name (Node));
2388
2389          when N_Slice =>
2390             Set_Debug_Sloc;
2391             Sprint_Node (Prefix (Node));
2392             Write_Str_With_Col_Check (" (");
2393             Sprint_Node (Discrete_Range (Node));
2394             Write_Char (')');
2395
2396          when N_String_Literal =>
2397             if String_Length (Strval (Node)) + Column > 75 then
2398                Write_Indent_Str ("  ");
2399             end if;
2400
2401             Set_Debug_Sloc;
2402             Write_String_Table_Entry (Strval (Node));
2403
2404          when N_Subprogram_Body =>
2405             if Freeze_Indent = 0 then
2406                Write_Indent;
2407             end if;
2408
2409             Write_Indent;
2410             Sprint_Node_Sloc (Specification (Node));
2411             Write_Str (" is");
2412
2413             Sprint_Indented_List (Declarations (Node));
2414             Write_Indent_Str ("begin");
2415             Sprint_Node (Handled_Statement_Sequence (Node));
2416
2417             Write_Indent_Str ("end ");
2418             Sprint_Node (Defining_Unit_Name (Specification (Node)));
2419             Write_Char (';');
2420
2421             if Is_List_Member (Node)
2422               and then Present (Next (Node))
2423               and then Nkind (Next (Node)) /= N_Subprogram_Body
2424             then
2425                Write_Indent;
2426             end if;
2427
2428          when N_Subprogram_Body_Stub =>
2429             Write_Indent;
2430             Sprint_Node_Sloc (Specification (Node));
2431             Write_Str_With_Col_Check (" is separate;");
2432
2433          when N_Subprogram_Declaration =>
2434             Write_Indent;
2435             Sprint_Node_Sloc (Specification (Node));
2436
2437             if Nkind (Specification (Node)) = N_Procedure_Specification
2438               and then Null_Present (Specification (Node))
2439             then
2440                Write_Str_With_Col_Check (" is null");
2441             end if;
2442
2443             Write_Char (';');
2444
2445          when N_Subprogram_Info =>
2446             Sprint_Node (Identifier (Node));
2447             Write_Str_With_Col_Check_Sloc ("'subprogram_info");
2448
2449          when N_Subprogram_Renaming_Declaration =>
2450             Write_Indent;
2451             Sprint_Node (Specification (Node));
2452             Write_Str_With_Col_Check_Sloc (" renames ");
2453             Sprint_Node (Name (Node));
2454             Write_Char (';');
2455
2456          when N_Subtype_Declaration =>
2457             Write_Indent_Str_Sloc ("subtype ");
2458             Write_Id (Defining_Identifier (Node));
2459             Write_Str (" is ");
2460
2461             --  Ada 2005 (AI-231)
2462
2463             if Null_Exclusion_Present (Node) then
2464                Write_Str ("not null ");
2465             end if;
2466
2467             Sprint_Node (Subtype_Indication (Node));
2468             Write_Char (';');
2469
2470          when N_Subtype_Indication =>
2471             Sprint_Node_Sloc (Subtype_Mark (Node));
2472             Write_Char (' ');
2473             Sprint_Node (Constraint (Node));
2474
2475          when N_Subunit =>
2476             Write_Indent_Str_Sloc ("separate (");
2477             Sprint_Node (Name (Node));
2478             Write_Char (')');
2479             Write_Eol;
2480             Sprint_Node (Proper_Body (Node));
2481
2482          when N_Task_Body =>
2483             Write_Indent_Str_Sloc ("task body ");
2484             Write_Id (Defining_Identifier (Node));
2485             Write_Str (" is");
2486             Sprint_Indented_List (Declarations (Node));
2487             Write_Indent_Str ("begin");
2488             Sprint_Node (Handled_Statement_Sequence (Node));
2489             Write_Indent_Str ("end ");
2490             Write_Id (Defining_Identifier (Node));
2491             Write_Char (';');
2492
2493          when N_Task_Body_Stub =>
2494             Write_Indent_Str_Sloc ("task body ");
2495             Write_Id (Defining_Identifier (Node));
2496             Write_Str_With_Col_Check (" is separate;");
2497
2498          when N_Task_Definition =>
2499             Set_Debug_Sloc;
2500             Sprint_Indented_List (Visible_Declarations (Node));
2501
2502             if Present (Private_Declarations (Node)) then
2503                Write_Indent_Str ("private");
2504                Sprint_Indented_List (Private_Declarations (Node));
2505             end if;
2506
2507             Write_Indent_Str ("end ");
2508
2509          when N_Task_Type_Declaration =>
2510             Write_Indent_Str_Sloc ("task type ");
2511             Write_Id (Defining_Identifier (Node));
2512             Write_Discr_Specs (Node);
2513
2514             if Present (Interface_List (Node)) then
2515                Write_Str (" is new ");
2516                Sprint_And_List (Interface_List (Node));
2517             end if;
2518
2519             if Present (Task_Definition (Node)) then
2520                if No (Interface_List (Node)) then
2521                   Write_Str (" is");
2522                else
2523                   Write_Str (" with ");
2524                end if;
2525
2526                Sprint_Node (Task_Definition (Node));
2527                Write_Id (Defining_Identifier (Node));
2528             end if;
2529
2530             Write_Char (';');
2531
2532          when N_Terminate_Alternative =>
2533             Sprint_Node_List (Pragmas_Before (Node));
2534
2535             Write_Indent;
2536
2537             if Present (Condition (Node)) then
2538                Write_Str_With_Col_Check ("when ");
2539                Sprint_Node (Condition (Node));
2540                Write_Str (" => ");
2541             end if;
2542
2543             Write_Str_With_Col_Check_Sloc ("terminate;");
2544             Sprint_Node_List (Pragmas_After (Node));
2545
2546          when N_Timed_Entry_Call =>
2547             Write_Indent_Str_Sloc ("select");
2548             Indent_Begin;
2549             Sprint_Node (Entry_Call_Alternative (Node));
2550             Indent_End;
2551             Write_Indent_Str ("or");
2552             Indent_Begin;
2553             Sprint_Node (Delay_Alternative (Node));
2554             Indent_End;
2555             Write_Indent_Str ("end select;");
2556
2557          when N_Triggering_Alternative =>
2558             Sprint_Node_List (Pragmas_Before (Node));
2559             Sprint_Node_Sloc (Triggering_Statement (Node));
2560             Sprint_Node_List (Statements (Node));
2561
2562          when N_Type_Conversion =>
2563             Set_Debug_Sloc;
2564             Sprint_Node (Subtype_Mark (Node));
2565             Col_Check (4);
2566
2567             if Conversion_OK (Node) then
2568                Write_Char ('?');
2569             end if;
2570
2571             if Float_Truncate (Node) then
2572                Write_Char ('^');
2573             end if;
2574
2575             if Rounded_Result (Node) then
2576                Write_Char ('@');
2577             end if;
2578
2579             Write_Char ('(');
2580             Sprint_Node (Expression (Node));
2581             Write_Char (')');
2582
2583          when N_Unchecked_Expression =>
2584             Col_Check (10);
2585             Write_Str ("`(");
2586             Sprint_Node_Sloc (Expression (Node));
2587             Write_Char (')');
2588
2589          when N_Unchecked_Type_Conversion =>
2590             Sprint_Node (Subtype_Mark (Node));
2591             Write_Char ('!');
2592             Write_Str_With_Col_Check ("(");
2593             Sprint_Node_Sloc (Expression (Node));
2594             Write_Char (')');
2595
2596          when N_Unconstrained_Array_Definition =>
2597             Write_Str_With_Col_Check_Sloc ("array (");
2598
2599             declare
2600                Node1 : Node_Id;
2601
2602             begin
2603                Node1 := First (Subtype_Marks (Node));
2604                loop
2605                   Sprint_Node (Node1);
2606                   Write_Str_With_Col_Check (" range <>");
2607                   Next (Node1);
2608                   exit when Node1 = Empty;
2609                   Write_Str (", ");
2610                end loop;
2611             end;
2612
2613             Write_Str (") of ");
2614             Sprint_Node (Component_Definition (Node));
2615
2616          when N_Unused_At_Start | N_Unused_At_End =>
2617             Write_Indent_Str ("***** Error, unused node encountered *****");
2618             Write_Eol;
2619
2620          when N_Use_Package_Clause =>
2621             Write_Indent_Str_Sloc ("use ");
2622             Sprint_Comma_List (Names (Node));
2623             Write_Char (';');
2624
2625          when N_Use_Type_Clause =>
2626             Write_Indent_Str_Sloc ("use type ");
2627             Sprint_Comma_List (Subtype_Marks (Node));
2628             Write_Char (';');
2629
2630          when N_Validate_Unchecked_Conversion =>
2631             Write_Indent_Str_Sloc ("validate unchecked_conversion (");
2632             Sprint_Node (Source_Type (Node));
2633             Write_Str (", ");
2634             Sprint_Node (Target_Type (Node));
2635             Write_Str (");");
2636
2637          when N_Variant =>
2638             Write_Indent_Str_Sloc ("when ");
2639             Sprint_Bar_List (Discrete_Choices (Node));
2640             Write_Str (" => ");
2641             Sprint_Node (Component_List (Node));
2642
2643          when N_Variant_Part =>
2644             Indent_Begin;
2645             Write_Indent_Str_Sloc ("case ");
2646             Sprint_Node (Name (Node));
2647             Write_Str (" is ");
2648             Sprint_Indented_List (Variants (Node));
2649             Write_Indent_Str ("end case");
2650             Indent_End;
2651
2652          when N_With_Clause =>
2653
2654             --  Special test, if we are dumping the original tree only,
2655             --  then we want to eliminate the bogus with clauses that
2656             --  correspond to the non-existent children of Text_IO.
2657
2658             if Dump_Original_Only
2659               and then Is_Text_IO_Kludge_Unit (Name (Node))
2660             then
2661                null;
2662
2663             --  Normal case, output the with clause
2664
2665             else
2666                if First_Name (Node) or else not Dump_Original_Only then
2667
2668                   --  Ada 2005 (AI-50217): Print limited with_clauses
2669
2670                   if Private_Present (Node) and Limited_Present (Node) then
2671                      Write_Indent_Str ("limited private with ");
2672
2673                   elsif Private_Present (Node) then
2674                      Write_Indent_Str ("private with ");
2675
2676                   elsif Limited_Present (Node) then
2677                      Write_Indent_Str ("limited with ");
2678
2679                   else
2680                      Write_Indent_Str ("with ");
2681                   end if;
2682
2683                else
2684                   Write_Str (", ");
2685                end if;
2686
2687                Sprint_Node_Sloc (Name (Node));
2688
2689                if Last_Name (Node) or else not Dump_Original_Only then
2690                   Write_Char (';');
2691                end if;
2692             end if;
2693
2694          when N_With_Type_Clause =>
2695             Write_Indent_Str ("with type ");
2696             Sprint_Node_Sloc (Name (Node));
2697
2698             if Tagged_Present (Node) then
2699                Write_Str (" is tagged;");
2700             else
2701                Write_Str (" is access;");
2702             end if;
2703
2704       end case;
2705
2706       if Nkind (Node) in N_Subexpr
2707         and then Do_Range_Check (Node)
2708       then
2709          Write_Str ("}");
2710       end if;
2711
2712       for J in 1 .. Paren_Count (Node) loop
2713          Write_Char (')');
2714       end loop;
2715
2716       pragma Assert (No (Debug_Node));
2717       Debug_Node := Save_Debug_Node;
2718    end Sprint_Node_Actual;
2719
2720    ----------------------
2721    -- Sprint_Node_List --
2722    ----------------------
2723
2724    procedure Sprint_Node_List (List : List_Id) is
2725       Node : Node_Id;
2726
2727    begin
2728       if Is_Non_Empty_List (List) then
2729          Node := First (List);
2730
2731          loop
2732             Sprint_Node (Node);
2733             Next (Node);
2734             exit when Node = Empty;
2735          end loop;
2736       end if;
2737    end Sprint_Node_List;
2738
2739    ----------------------
2740    -- Sprint_Node_Sloc --
2741    ----------------------
2742
2743    procedure Sprint_Node_Sloc (Node : Node_Id) is
2744    begin
2745       Sprint_Node (Node);
2746
2747       if Present (Debug_Node) then
2748          Set_Sloc (Debug_Node, Sloc (Node));
2749          Debug_Node := Empty;
2750       end if;
2751    end Sprint_Node_Sloc;
2752
2753    ---------------------
2754    -- Sprint_Opt_Node --
2755    ---------------------
2756
2757    procedure Sprint_Opt_Node (Node : Node_Id) is
2758    begin
2759       if Present (Node) then
2760          Write_Char (' ');
2761          Sprint_Node (Node);
2762       end if;
2763    end Sprint_Opt_Node;
2764
2765    --------------------------
2766    -- Sprint_Opt_Node_List --
2767    --------------------------
2768
2769    procedure Sprint_Opt_Node_List (List : List_Id) is
2770    begin
2771       if Present (List) then
2772          Sprint_Node_List (List);
2773       end if;
2774    end Sprint_Opt_Node_List;
2775
2776    ---------------------------------
2777    -- Sprint_Opt_Paren_Comma_List --
2778    ---------------------------------
2779
2780    procedure Sprint_Opt_Paren_Comma_List (List : List_Id) is
2781    begin
2782       if Is_Non_Empty_List (List) then
2783          Write_Char (' ');
2784          Sprint_Paren_Comma_List (List);
2785       end if;
2786    end Sprint_Opt_Paren_Comma_List;
2787
2788    -----------------------------
2789    -- Sprint_Paren_Comma_List --
2790    -----------------------------
2791
2792    procedure Sprint_Paren_Comma_List (List : List_Id) is
2793       N           : Node_Id;
2794       Node_Exists : Boolean := False;
2795
2796    begin
2797
2798       if Is_Non_Empty_List (List) then
2799
2800          if Dump_Original_Only then
2801             N := First (List);
2802
2803             while Present (N) loop
2804
2805                if not Is_Rewrite_Insertion (N) then
2806                   Node_Exists := True;
2807                   exit;
2808                end if;
2809
2810                Next (N);
2811             end loop;
2812
2813             if not Node_Exists then
2814                return;
2815             end if;
2816          end if;
2817
2818          Write_Str_With_Col_Check ("(");
2819          Sprint_Comma_List (List);
2820          Write_Char (')');
2821       end if;
2822    end Sprint_Paren_Comma_List;
2823
2824    ----------------------
2825    -- Sprint_Right_Opnd --
2826    ----------------------
2827
2828    procedure Sprint_Right_Opnd (N : Node_Id) is
2829       Opnd : constant Node_Id := Right_Opnd (N);
2830
2831    begin
2832       if Paren_Count (Opnd) /= 0
2833         or else Op_Prec (Nkind (Opnd)) > Op_Prec (Nkind (N))
2834       then
2835          Sprint_Node (Opnd);
2836
2837       else
2838          Write_Char ('(');
2839          Sprint_Node (Opnd);
2840          Write_Char (')');
2841       end if;
2842    end Sprint_Right_Opnd;
2843
2844    ---------------------
2845    -- Write_Char_Sloc --
2846    ---------------------
2847
2848    procedure Write_Char_Sloc (C : Character) is
2849    begin
2850       if Debug_Generated_Code and then C /= ' ' then
2851          Set_Debug_Sloc;
2852       end if;
2853
2854       Write_Char (C);
2855    end Write_Char_Sloc;
2856
2857    --------------------------------
2858    -- Write_Condition_And_Reason --
2859    --------------------------------
2860
2861    procedure Write_Condition_And_Reason (Node : Node_Id) is
2862       Image : constant String := RT_Exception_Code'Image
2863                                    (RT_Exception_Code'Val
2864                                      (UI_To_Int (Reason (Node))));
2865
2866    begin
2867       if Present (Condition (Node)) then
2868          Write_Str_With_Col_Check (" when ");
2869          Sprint_Node (Condition (Node));
2870       end if;
2871
2872       Write_Str (" """);
2873
2874       for J in 4 .. Image'Last loop
2875          if Image (J) = '_' then
2876             Write_Char (' ');
2877          else
2878             Write_Char (Fold_Lower (Image (J)));
2879          end if;
2880       end loop;
2881
2882       Write_Str ("""]");
2883    end Write_Condition_And_Reason;
2884
2885    -----------------------
2886    -- Write_Discr_Specs --
2887    -----------------------
2888
2889    procedure Write_Discr_Specs (N : Node_Id) is
2890       Specs : List_Id;
2891       Spec  : Node_Id;
2892
2893    begin
2894       Specs := Discriminant_Specifications (N);
2895
2896       if Present (Specs) then
2897          Write_Str_With_Col_Check (" (");
2898          Spec := First (Specs);
2899
2900          loop
2901             Sprint_Node (Spec);
2902             Next (Spec);
2903             exit when Spec = Empty;
2904
2905             --  Add semicolon, unless we are printing original tree and the
2906             --  next specification is part of a list (but not the first
2907             --  element of that list)
2908
2909             if not Dump_Original_Only or else not Prev_Ids (Spec) then
2910                Write_Str ("; ");
2911             end if;
2912          end loop;
2913
2914          Write_Char (')');
2915       end if;
2916    end Write_Discr_Specs;
2917
2918    -----------------
2919    -- Write_Ekind --
2920    -----------------
2921
2922    procedure Write_Ekind (E : Entity_Id) is
2923       S : constant String := Entity_Kind'Image (Ekind (E));
2924
2925    begin
2926       Name_Len := S'Length;
2927       Name_Buffer (1 .. Name_Len) := S;
2928       Set_Casing (Mixed_Case);
2929       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
2930    end Write_Ekind;
2931
2932    --------------
2933    -- Write_Id --
2934    --------------
2935
2936    procedure Write_Id (N : Node_Id) is
2937    begin
2938       --  Case of a defining identifier
2939
2940       if Nkind (N) = N_Defining_Identifier then
2941
2942          --  If defining identifier has an interface name (and no
2943          --  address clause), then we output the interface name.
2944
2945          if (Is_Imported (N) or else Is_Exported (N))
2946            and then Present (Interface_Name (N))
2947            and then No (Address_Clause (N))
2948          then
2949             String_To_Name_Buffer (Strval (Interface_Name (N)));
2950             Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
2951
2952          --  If no interface name (or inactive because there was
2953          --  an address clause), then just output the Chars name.
2954
2955          else
2956             Write_Name_With_Col_Check (Chars (N));
2957          end if;
2958
2959       --  Case of selector of an expanded name where the expanded name
2960       --  has an associated entity, output this entity.
2961
2962       elsif Nkind (Parent (N)) = N_Expanded_Name
2963         and then Selector_Name (Parent (N)) = N
2964         and then Present (Entity (Parent (N)))
2965       then
2966          Write_Id (Entity (Parent (N)));
2967
2968       --  For any other node with an associated entity, output it
2969
2970       elsif Nkind (N) in N_Has_Entity
2971         and then Present (Entity_Or_Associated_Node (N))
2972         and then Nkind (Entity_Or_Associated_Node (N)) in N_Entity
2973       then
2974          Write_Id (Entity (N));
2975
2976       --  All other cases, we just print the Chars field
2977
2978       else
2979          Write_Name_With_Col_Check (Chars (N));
2980       end if;
2981    end Write_Id;
2982
2983    -----------------------
2984    -- Write_Identifiers --
2985    -----------------------
2986
2987    function Write_Identifiers (Node : Node_Id) return Boolean is
2988    begin
2989       Sprint_Node (Defining_Identifier (Node));
2990
2991       --  The remainder of the declaration must be printed unless we are
2992       --  printing the original tree and this is not the last identifier
2993
2994       return
2995          not Dump_Original_Only or else not More_Ids (Node);
2996
2997    end Write_Identifiers;
2998
2999    ------------------------
3000    -- Write_Implicit_Def --
3001    ------------------------
3002
3003    procedure Write_Implicit_Def (E : Entity_Id) is
3004       Ind : Node_Id;
3005
3006    begin
3007       case Ekind (E) is
3008          when E_Array_Subtype =>
3009             Write_Str_With_Col_Check ("subtype ");
3010             Write_Id (E);
3011             Write_Str_With_Col_Check (" is ");
3012             Write_Id (Base_Type (E));
3013             Write_Str_With_Col_Check (" (");
3014
3015             Ind := First_Index (E);
3016
3017             while Present (Ind) loop
3018                Sprint_Node (Ind);
3019                Next_Index (Ind);
3020
3021                if Present (Ind) then
3022                   Write_Str (", ");
3023                end if;
3024             end loop;
3025
3026             Write_Str (");");
3027
3028          when E_Signed_Integer_Subtype | E_Enumeration_Subtype =>
3029             Write_Str_With_Col_Check ("subtype ");
3030             Write_Id (E);
3031             Write_Str (" is ");
3032             Write_Id (Etype (E));
3033             Write_Str_With_Col_Check (" range ");
3034             Sprint_Node (Scalar_Range (E));
3035             Write_Str (";");
3036
3037          when others =>
3038             Write_Str_With_Col_Check ("type ");
3039             Write_Id (E);
3040             Write_Str_With_Col_Check (" is <");
3041             Write_Ekind (E);
3042             Write_Str (">;");
3043       end case;
3044
3045    end Write_Implicit_Def;
3046
3047    ------------------
3048    -- Write_Indent --
3049    ------------------
3050
3051    procedure Write_Indent is
3052    begin
3053       if Indent_Annull_Flag then
3054          Indent_Annull_Flag := False;
3055       else
3056          Write_Eol;
3057
3058          for J in 1 .. Indent loop
3059             Write_Char (' ');
3060          end loop;
3061       end if;
3062    end Write_Indent;
3063
3064    ------------------------------
3065    -- Write_Indent_Identifiers --
3066    ------------------------------
3067
3068    function Write_Indent_Identifiers (Node : Node_Id) return Boolean is
3069    begin
3070       --  We need to start a new line for every node, except in the case
3071       --  where we are printing the original tree and this is not the first
3072       --  defining identifier in the list.
3073
3074       if not Dump_Original_Only or else not Prev_Ids (Node) then
3075          Write_Indent;
3076
3077       --  If printing original tree and this is not the first defining
3078       --  identifier in the list, then the previous call to this procedure
3079       --  printed only the name, and we add a comma to separate the names.
3080
3081       else
3082          Write_Str (", ");
3083       end if;
3084
3085       Sprint_Node (Defining_Identifier (Node));
3086
3087       --  The remainder of the declaration must be printed unless we are
3088       --  printing the original tree and this is not the last identifier
3089
3090       return
3091          not Dump_Original_Only or else not More_Ids (Node);
3092
3093    end Write_Indent_Identifiers;
3094
3095    -----------------------------------
3096    -- Write_Indent_Identifiers_Sloc --
3097    -----------------------------------
3098
3099    function Write_Indent_Identifiers_Sloc (Node : Node_Id) return Boolean is
3100    begin
3101       --  We need to start a new line for every node, except in the case
3102       --  where we are printing the original tree and this is not the first
3103       --  defining identifier in the list.
3104
3105       if not Dump_Original_Only or else not Prev_Ids (Node) then
3106          Write_Indent;
3107
3108       --  If printing original tree and this is not the first defining
3109       --  identifier in the list, then the previous call to this procedure
3110       --  printed only the name, and we add a comma to separate the names.
3111
3112       else
3113          Write_Str (", ");
3114       end if;
3115
3116       Set_Debug_Sloc;
3117       Sprint_Node (Defining_Identifier (Node));
3118
3119       --  The remainder of the declaration must be printed unless we are
3120       --  printing the original tree and this is not the last identifier
3121
3122       return
3123          not Dump_Original_Only or else not More_Ids (Node);
3124
3125    end Write_Indent_Identifiers_Sloc;
3126
3127    ----------------------
3128    -- Write_Indent_Str --
3129    ----------------------
3130
3131    procedure Write_Indent_Str (S : String) is
3132    begin
3133       Write_Indent;
3134       Write_Str (S);
3135    end Write_Indent_Str;
3136
3137    ---------------------------
3138    -- Write_Indent_Str_Sloc --
3139    ---------------------------
3140
3141    procedure Write_Indent_Str_Sloc (S : String) is
3142    begin
3143       Write_Indent;
3144       Write_Str_Sloc (S);
3145    end Write_Indent_Str_Sloc;
3146
3147    -------------------------------
3148    -- Write_Name_With_Col_Check --
3149    -------------------------------
3150
3151    procedure Write_Name_With_Col_Check (N : Name_Id) is
3152       J : Natural;
3153
3154    begin
3155       Get_Name_String (N);
3156
3157       --  Deal with -gnatI which replaces digits in an internal
3158       --  name by three dots (e.g. R7b becomes R...b).
3159
3160       if Debug_Flag_II and then Name_Buffer (1) in 'A' .. 'Z' then
3161
3162          J := 2;
3163          while J < Name_Len loop
3164             exit when Name_Buffer (J) not in 'A' .. 'Z';
3165             J := J + 1;
3166          end loop;
3167
3168          if Name_Buffer (J) in '0' .. '9' then
3169             Write_Str_With_Col_Check (Name_Buffer (1 .. J - 1));
3170             Write_Str ("...");
3171
3172             while J <= Name_Len loop
3173                if Name_Buffer (J) not in '0' .. '9' then
3174                   Write_Str (Name_Buffer (J .. Name_Len));
3175                   exit;
3176
3177                else
3178                   J := J + 1;
3179                end if;
3180             end loop;
3181
3182             return;
3183          end if;
3184       end if;
3185
3186       --  Fall through for normal case
3187
3188       Write_Str_With_Col_Check (Name_Buffer (1 .. Name_Len));
3189    end Write_Name_With_Col_Check;
3190
3191    ------------------------------------
3192    -- Write_Name_With_Col_Check_Sloc --
3193    ------------------------------------
3194
3195    procedure Write_Name_With_Col_Check_Sloc (N : Name_Id) is
3196    begin
3197       Get_Name_String (N);
3198       Write_Str_With_Col_Check_Sloc (Name_Buffer (1 .. Name_Len));
3199    end Write_Name_With_Col_Check_Sloc;
3200
3201    --------------------
3202    -- Write_Operator --
3203    --------------------
3204
3205    procedure Write_Operator (N : Node_Id; S : String) is
3206       F : Natural := S'First;
3207       T : Natural := S'Last;
3208
3209    begin
3210       --  If no overflow check, just write string out, and we are done
3211
3212       if not Do_Overflow_Check (N) then
3213          Write_Str_Sloc (S);
3214
3215       --  If overflow check, we want to surround the operator with curly
3216       --  brackets, but not include spaces within the brackets.
3217
3218       else
3219          if S (F) = ' ' then
3220             Write_Char (' ');
3221             F := F + 1;
3222          end if;
3223
3224          if S (T) = ' ' then
3225             T := T - 1;
3226          end if;
3227
3228          Write_Char ('{');
3229          Write_Str_Sloc (S (F .. T));
3230          Write_Char ('}');
3231
3232          if S (S'Last) = ' ' then
3233             Write_Char (' ');
3234          end if;
3235       end if;
3236    end Write_Operator;
3237
3238    -----------------------
3239    -- Write_Param_Specs --
3240    -----------------------
3241
3242    procedure Write_Param_Specs (N : Node_Id) is
3243       Specs  : List_Id;
3244       Spec   : Node_Id;
3245       Formal : Node_Id;
3246
3247    begin
3248       Specs := Parameter_Specifications (N);
3249
3250       if Is_Non_Empty_List (Specs) then
3251          Write_Str_With_Col_Check (" (");
3252          Spec := First (Specs);
3253
3254          loop
3255             Sprint_Node (Spec);
3256             Formal := Defining_Identifier (Spec);
3257             Next (Spec);
3258             exit when Spec = Empty;
3259
3260             --  Add semicolon, unless we are printing original tree and the
3261             --  next specification is part of a list (but not the first
3262             --  element of that list)
3263
3264             if not Dump_Original_Only or else not Prev_Ids (Spec) then
3265                Write_Str ("; ");
3266             end if;
3267          end loop;
3268
3269          --  Write out any extra formals
3270
3271          while Present (Extra_Formal (Formal)) loop
3272             Formal := Extra_Formal (Formal);
3273             Write_Str ("; ");
3274             Write_Name_With_Col_Check (Chars (Formal));
3275             Write_Str (" : ");
3276             Write_Name_With_Col_Check (Chars (Etype (Formal)));
3277          end loop;
3278
3279          Write_Char (')');
3280       end if;
3281    end Write_Param_Specs;
3282
3283    --------------------------
3284    -- Write_Rewrite_Str --
3285    --------------------------
3286
3287    procedure Write_Rewrite_Str (S : String) is
3288    begin
3289       if not Dump_Generated_Only then
3290          if S'Length = 3 and then S = ">>>" then
3291             Write_Str (">>>");
3292          else
3293             Write_Str_With_Col_Check (S);
3294          end if;
3295       end if;
3296    end Write_Rewrite_Str;
3297
3298    --------------------
3299    -- Write_Str_Sloc --
3300    --------------------
3301
3302    procedure Write_Str_Sloc (S : String) is
3303    begin
3304       for J in S'Range loop
3305          Write_Char_Sloc (S (J));
3306       end loop;
3307    end Write_Str_Sloc;
3308
3309    ------------------------------
3310    -- Write_Str_With_Col_Check --
3311    ------------------------------
3312
3313    procedure Write_Str_With_Col_Check (S : String) is
3314    begin
3315       if Int (S'Last) + Column > Line_Limit then
3316          Write_Indent_Str ("  ");
3317
3318          if S (1) = ' ' then
3319             Write_Str (S (2 .. S'Length));
3320          else
3321             Write_Str (S);
3322          end if;
3323
3324       else
3325          Write_Str (S);
3326       end if;
3327    end Write_Str_With_Col_Check;
3328
3329    -----------------------------------
3330    -- Write_Str_With_Col_Check_Sloc --
3331    -----------------------------------
3332
3333    procedure Write_Str_With_Col_Check_Sloc (S : String) is
3334    begin
3335       if Int (S'Last) + Column > Line_Limit then
3336          Write_Indent_Str ("  ");
3337
3338          if S (1) = ' ' then
3339             Write_Str_Sloc (S (2 .. S'Length));
3340          else
3341             Write_Str_Sloc (S);
3342          end if;
3343
3344       else
3345          Write_Str_Sloc (S);
3346       end if;
3347    end Write_Str_With_Col_Check_Sloc;
3348
3349    ------------------------------------
3350    -- Write_Uint_With_Col_Check_Sloc --
3351    ------------------------------------
3352
3353    procedure Write_Uint_With_Col_Check_Sloc (U : Uint; Format : UI_Format) is
3354    begin
3355       Col_Check (UI_Decimal_Digits_Hi (U));
3356       Set_Debug_Sloc;
3357       UI_Write (U, Format);
3358    end Write_Uint_With_Col_Check_Sloc;
3359
3360    -------------------------------------
3361    -- Write_Ureal_With_Col_Check_Sloc --
3362    -------------------------------------
3363
3364    procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
3365       D : constant Uint := Denominator (U);
3366       N : constant Uint := Numerator (U);
3367
3368    begin
3369       Col_Check
3370         (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
3371       Set_Debug_Sloc;
3372       UR_Write (U);
3373    end Write_Ureal_With_Col_Check_Sloc;
3374
3375 end Sprint;