OpenAADL / ocarina
1
------------------------------------------------------------------------------
2
--                                                                          --
3
--                           OCARINA COMPONENTS                             --
4
--                                                                          --
5
--  O C A R I N A . B A C K E N D S . A D A _ T R E E . G E N E R A T O R   --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--               Copyright (C) 2006-2009 Telecom ParisTech,                 --
10
--                 2010-2019 ESA & ISAE, 2019-2020 OpenAADL                 --
11
--                                                                          --
12
-- Ocarina  is free software; you can redistribute it and/or modify under   --
13
-- terms of the  GNU General Public License as published  by the Free Soft- --
14
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
15
-- sion. Ocarina is distributed in the hope that it will be useful, but     --
16
-- WITHOUT ANY WARRANTY; without even the implied warranty of               --
17
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
--                    Ocarina is maintained by OpenAADL team                --
29
--                              (info@openaadl.org)                         --
30
--                                                                          --
31
------------------------------------------------------------------------------
32

33
with Ocarina.Namet;  use Ocarina.Namet;
34
with Ocarina.Output; use Ocarina.Output;
35
with Utils;          use Utils;
36
with Outfiles;       use Outfiles;
37

38
with GNAT.OS_Lib; use GNAT.OS_Lib;
39

40
with Ocarina.Backends.Utils;
41
with Ocarina.Backends.Ada_Tree.Nodes;
42
with Ocarina.Backends.Ada_Tree.Nutils;
43
with Ocarina.Backends.Ada_Values;
44

45
package body Ocarina.Backends.Ada_Tree.Generator is
46

47
   use Ocarina.Backends.Utils;
48
   use Ocarina.Backends.Ada_Tree.Nodes;
49
   use Ocarina.Backends.Ada_Tree.Nutils;
50
   use Ocarina.Backends.Ada_Values;
51

52
   procedure Generate_Access_Type_Definition (N : Node_Id);
53
   procedure Generate_Ada_Comment (N : Node_Id);
54
   procedure Generate_Aspect (N : Node_Id);
55
   procedure Generate_HI_Distributed_Application (N : Node_Id);
56
   procedure Generate_HI_Node (N : Node_Id);
57
   procedure Generate_Unit_Packages (N : Node_Id);
58
   procedure Generate_Array_Aggregate (N : Node_Id);
59
   procedure Generate_Array_Type_Definition (N : Node_Id);
60
   procedure Generate_Assignment_Statement (N : Node_Id);
61
   procedure Generate_Attribute_Designator (N : Node_Id);
62
   procedure Generate_Attribute_Definition_Clause (N : Node_Id);
63
   procedure Generate_Block_Statement (N : Node_Id);
64
   procedure Generate_Case_Label (N : Node_Id);
65
   procedure Generate_Case_Statement (N : Node_Id);
66
   procedure Generate_Component_Association (N : Node_Id);
67
   procedure Generate_Component_Declaration (N : Node_Id);
68
   procedure Generate_Decimal_Type_Definition (N : Node_Id);
69
   procedure Generate_Defining_Identifier (N : Node_Id);
70
   procedure Generate_Delay_Statement (N : Node_Id);
71
   procedure Generate_Derived_Type_Definition (N : Node_Id);
72
   procedure Generate_Designator (N : Node_Id);
73
   procedure Generate_Element_Association (N : Node_Id);
74
   procedure Generate_Elsif_Statement (N : Node_Id);
75
   procedure Generate_Enumeration_Type_Definition (N : Node_Id);
76
   procedure Generate_Enumeration_Representation_Clause (N : Node_Id);
77
   procedure Generate_Exception_Declaration (N : Node_Id);
78
   procedure Generate_Explicit_Dereference (N : Node_Id);
79
   procedure Generate_Expression (N : Node_Id);
80
   procedure Generate_For_Statement (N : Node_Id);
81
   procedure Generate_Full_Type_Declaration (N : Node_Id);
82
   procedure Generate_If_Statement (N : Node_Id);
83
   procedure Generate_Indexed_Component (N : Node_Id);
84
   procedure Generate_Literal (N : Node_Id);
85
   procedure Generate_Loop_Statement (N : Node_Id);
86
   procedure Generate_Main_Subprogram_Implementation (N : Node_Id);
87
   procedure Generate_Null_Statement;
88
   procedure Generate_Object_Declaration (N : Node_Id);
89
   procedure Generate_Object_Instantiation (N : Node_Id);
90
   procedure Generate_Package_Declaration (N : Node_Id);
91
   procedure Generate_Package_Implementation (N : Node_Id);
92
   procedure Generate_Package_Instantiation (N : Node_Id);
93
   procedure Generate_Package_Specification (N : Node_Id);
94
   procedure Generate_Parameter (N : Node_Id);
95
   procedure Generate_Parameter_Association (N : Node_Id);
96
   procedure Generate_Parameter_List (L : List_Id);
97
   procedure Generate_Pragma_Statement (N : Node_Id);
98
   procedure Generate_Protected_Object_Spec (N : Node_Id);
99
   procedure Generate_Protected_Object_Body (N : Node_Id);
100
   procedure Generate_Qualified_Expression (N : Node_Id);
101
   procedure Generate_Range_Constraint (N : Node_Id);
102
   procedure Generate_Raise_Statement (N : Node_Id);
103
   procedure Generate_Record_Aggregate (N : Node_Id);
104
   procedure Generate_Record_Definition (N : Node_Id);
105
   procedure Generate_Record_Type_Definition (N : Node_Id);
106
   procedure Generate_Private_Type_Definition (N : Node_Id);
107
   procedure Generate_Return_Statement (N : Node_Id);
108
   procedure Generate_Selected_Component (N : Node_Id);
109
   procedure Generate_Subprogram_Call (N : Node_Id);
110
   procedure Generate_Subprogram_Implementation (N : Node_Id);
111
   procedure Generate_Subprogram_Specification (N : Node_Id);
112
   procedure Generate_Used_Type (N : Node_Id);
113
   procedure Generate_Used_Package (N : Node_Id);
114
   procedure Generate_Type_Conversion (N : Node_Id);
115
   procedure Generate_Variant_Part (N : Node_Id);
116
   procedure Generate_Withed_Package (N : Node_Id);
117
   procedure Generate_Exit_When_Statement (N : Node_Id);
118

119
   procedure Write (T : Token_Type);
120
   procedure Write_Line (T : Token_Type);
121

122
   procedure Generate_Statement_Delimiter (N : Node_Id);
123
   procedure Generate_Comment_Box (M : Name_Id);
124

125
   type Pragma_W is (W_On, W_Off);
126
   procedure Generate_Pragma_Warnings (W : Pragma_W);
127
   --  Generate pragma Warnings (Off|On);
128

129
   --  The entities declared below are relared to the package
130
   --  generation in different files
131

132
   function Get_File_Name (N : Node_Id) return Name_Id;
133
   --  Generate an Ada file name from the package node given as
134
   --  parameter
135

136
   -------------------
137
   -- Get_File_Name --
138
   -------------------
139

140 1
   function Get_File_Name (N : Node_Id) return Name_Id is
141
      pragma Assert
142 1
        (Kind (N) = K_Package_Specification
143 1
         or else Kind (N) = K_Package_Implementation
144 1
         or else Kind (N) = K_Subprogram_Specification
145 1
         or else Kind (N) = K_Subprogram_Implementation);
146

147
      Package_Spec_Suffix : constant String := ".ads";
148
      Package_Body_Suffix : constant String := ".adb";
149
   begin
150
      --  The File name corresponding to a package is the lowerd fully
151
      --  qualified name of the package. All '.' separators are
152
      --  replaced by '-'.
153

154 1
      if Kind (N) = K_Subprogram_Implementation
155 1
        or else Kind (N) = K_Subprogram_Specification
156
      then
157
         --  If the user supplied a custom file name, we use it
158

159 1
         if Has_Custom_File_Name (Main_Subprogram_Unit (N)) then
160 0
            Get_Name_String (File_Name (Main_Subprogram_Unit (N)));
161
         else
162 1
            Get_Name_String
163 1
              (Conventional_Base_Name
164 1
                 (Fully_Qualified_Name
165 1
                    (Defining_Identifier (Main_Subprogram_Unit (N)))));
166
         end if;
167
      else
168 1
         if Has_Custom_File_Name (Package_Declaration (N)) then
169 0
            Get_Name_String (File_Name (Package_Declaration (N)));
170
         else
171 1
            Get_Name_String
172 1
              (Conventional_Base_Name
173 1
                 (Fully_Qualified_Name
174 1
                    (Defining_Identifier (Package_Declaration (N)))));
175
         end if;
176
      end if;
177

178
      --  Adding file suffix
179

180 1
      if Kind (N) = K_Package_Specification
181 1
        or else Kind (N) = K_Subprogram_Specification
182
      then
183 1
         Add_Str_To_Name_Buffer (Package_Spec_Suffix);
184
      else
185 1
         Add_Str_To_Name_Buffer (Package_Body_Suffix);
186
      end if;
187

188 1
      return Name_Find;
189
   end Get_File_Name;
190

191
   --------------
192
   -- Generate --
193
   --------------
194

195 1
   procedure Generate (N : Node_Id) is
196
   begin
197 1
      case Kind (N) is
198 1
         when K_Private_Type_Definition =>
199 1
            Generate_Private_Type_Definition (N);
200

201 0
         when K_Access_Type_Definition =>
202 0
            Generate_Access_Type_Definition (N);
203

204 1
         when K_Ada_Comment =>
205 1
            Generate_Ada_Comment (N);
206

207 1
         when K_HI_Distributed_Application =>
208 1
            Generate_HI_Distributed_Application (N);
209

210 1
         when K_HI_Node =>
211 1
            Generate_HI_Node (N);
212

213 1
         when K_HI_Unit =>
214 1
            Generate_Unit_Packages (N);
215

216 1
         when K_Array_Aggregate =>
217 1
            Generate_Array_Aggregate (N);
218

219 1
         when K_Array_Type_Definition =>
220 1
            Generate_Array_Type_Definition (N);
221

222 1
         when K_Assignment_Statement =>
223 1
            Generate_Assignment_Statement (N);
224

225 1
         when K_Attribute_Definition_Clause =>
226 1
            Generate_Attribute_Definition_Clause (N);
227

228 1
         when K_Attribute_Designator =>
229 1
            Generate_Attribute_Designator (N);
230

231 0
         when K_Block_Statement =>
232 0
            Generate_Block_Statement (N);
233

234 0
         when K_Case_Label =>
235 0
            Generate_Case_Label (N);
236

237 1
         when K_Case_Statement =>
238 1
            Generate_Case_Statement (N);
239

240 1
         when K_Component_Association =>
241 1
            Generate_Component_Association (N);
242

243 1
         when K_Component_Declaration =>
244 1
            Generate_Component_Declaration (N);
245

246 1
         when K_Decimal_Type_Definition =>
247 1
            Generate_Decimal_Type_Definition (N);
248

249 1
         when K_Defining_Identifier =>
250 1
            Generate_Defining_Identifier (N);
251

252 0
         when K_Delay_Statement =>
253 0
            Generate_Delay_Statement (N);
254

255 1
         when K_Derived_Type_Definition =>
256 1
            Generate_Derived_Type_Definition (N);
257

258 1
         when K_Designator =>
259 1
            Generate_Designator (N);
260

261 1
         when K_Element_Association =>
262 1
            Generate_Element_Association (N);
263

264 1
         when K_Elsif_Statement =>
265 1
            Generate_Elsif_Statement (N);
266

267 1
         when K_Enumeration_Type_Definition =>
268 1
            Generate_Enumeration_Type_Definition (N);
269

270 1
         when K_Enumeration_Representation_Clause =>
271 1
            Generate_Enumeration_Representation_Clause (N);
272

273 1
         when K_Exception_Declaration =>
274 1
            Generate_Exception_Declaration (N);
275

276 0
         when K_Explicit_Dereference =>
277 0
            Generate_Explicit_Dereference (N);
278

279 1
         when K_Expression =>
280 1
            Generate_Expression (N);
281

282 0
         when K_For_Statement =>
283 0
            Generate_For_Statement (N);
284

285 1
         when K_Full_Type_Declaration =>
286 1
            Generate_Full_Type_Declaration (N);
287

288 1
         when K_If_Statement =>
289 1
            Generate_If_Statement (N);
290

291 1
         when K_Indexed_Component =>
292 1
            Generate_Indexed_Component (N);
293

294 1
         when K_Literal =>
295 1
            Generate_Literal (N);
296

297 0
         when K_Loop_Statement =>
298 0
            Generate_Loop_Statement (N);
299

300 1
         when K_Main_Subprogram_Implementation =>
301 1
            Generate_Main_Subprogram_Implementation (N);
302

303 1
         when K_Null_Statement =>
304 1
            Generate_Null_Statement;
305

306 1
         when K_Object_Declaration =>
307 1
            Generate_Object_Declaration (N);
308

309 0
         when K_Object_Instantiation =>
310 0
            Generate_Object_Instantiation (N);
311

312 1
         when K_Package_Declaration =>
313 1
            Generate_Package_Declaration (N);
314

315 1
         when K_Package_Implementation =>
316 1
            Generate_Package_Implementation (N);
317

318 1
         when K_Package_Instantiation =>
319 1
            Generate_Package_Instantiation (N);
320

321 1
         when K_Package_Specification =>
322 1
            Generate_Package_Specification (N);
323

324 1
         when K_Parameter_Association =>
325 1
            Generate_Parameter_Association (N);
326

327 1
         when K_Pragma_Statement =>
328 1
            Generate_Pragma_Statement (N);
329

330 1
         when K_Protected_Object_Spec =>
331 1
            Generate_Protected_Object_Spec (N);
332

333 1
         when K_Protected_Object_Body =>
334 1
            Generate_Protected_Object_Body (N);
335

336 1
         when K_Qualified_Expression =>
337 1
            Generate_Qualified_Expression (N);
338

339 1
         when K_Range_Constraint =>
340 1
            Generate_Range_Constraint (N);
341

342 1
         when K_Raise_Statement =>
343 1
            Generate_Raise_Statement (N);
344

345 1
         when K_Record_Aggregate =>
346 1
            Generate_Record_Aggregate (N);
347

348 1
         when K_Record_Definition =>
349 1
            Generate_Record_Definition (N);
350

351 1
         when K_Record_Type_Definition =>
352 1
            Generate_Record_Type_Definition (N);
353

354 1
         when K_Return_Statement =>
355 1
            Generate_Return_Statement (N);
356

357 1
         when K_Selected_Component =>
358 1
            Generate_Selected_Component (N);
359

360 1
         when K_Subprogram_Call =>
361 1
            Generate_Subprogram_Call (N);
362

363 1
         when K_Subprogram_Specification =>
364 1
            Generate_Subprogram_Specification (N);
365

366 1
         when K_Subprogram_Implementation =>
367 1
            Generate_Subprogram_Implementation (N);
368

369 0
         when K_Type_Conversion =>
370 0
            Generate_Type_Conversion (N);
371

372 1
         when K_Used_Type =>
373 1
            Generate_Used_Type (N);
374

375 1
         when K_Used_Package =>
376 1
            Generate_Used_Package (N);
377

378 1
         when K_Variant_Part =>
379 1
            Generate_Variant_Part (N);
380

381 0
         when K_Exit_When_Statement =>
382 0
            Generate_Exit_When_Statement (N);
383

384 1
         when K_Withed_Package =>
385 1
            Generate_Withed_Package (N);
386

387 0
         when K_Boolean .. K_String =>
388 0
            Write_Name (Image (Base_Type (N)));
389

390 0
         when others =>
391 0
            null;
392 1
      end case;
393 1
   end Generate;
394

395
   --------------------------------------
396
   -- Generate_Private_Type_Definition --
397
   --------------------------------------
398

399 1
   procedure Generate_Private_Type_Definition (N : Node_Id) is
400
      pragma Unreferenced (N);
401
   begin
402 1
      Write (Tok_Private);
403 1
   end Generate_Private_Type_Definition;
404

405
   -------------------------------------
406
   -- Generate_Access_Type_Definition --
407
   -------------------------------------
408

409 0
   procedure Generate_Access_Type_Definition (N : Node_Id) is
410
   begin
411 0
      if Is_Not_Null (N) then
412 0
         Write (Tok_Not);
413 0
         Write_Space;
414 0
         Write (Tok_Null);
415 0
         Write_Space;
416
      end if;
417

418 0
      Write (Tok_Access);
419 0
      Write_Space;
420

421 0
      if Is_All (N) then
422 0
         Write (Tok_All);
423 0
         Write_Space;
424
      end if;
425

426 0
      if Is_Constant (N) then
427 0
         Write (Tok_Constant);
428 0
         Write_Space;
429
      end if;
430

431 0
      Generate (Subtype_Indication (N));
432 0
   end Generate_Access_Type_Definition;
433

434
   --------------------------
435
   -- Generate_Ada_Comment --
436
   --------------------------
437

438 1
   procedure Generate_Ada_Comment (N : Node_Id) is
439
      --  This procedure does the following:
440

441
      --  * It generates an Ada comment basing on the name of node N
442

443
      --  * If the name it too long, and depending on the location of
444
      --    the comment in the source code, the procedure splits the
445
      --    comment into more than a line.
446

447
      --  The comment is assumed to be a sequence of caracters,
448
      --  beginning and ending with a NON-SPACE caracter.
449

450
      --  A word is:
451

452
      --  a space character, or else a sequence of non space
453
      --  characters located between two spaces.
454

455
      --  The maximum length of a line, in colums
456 1
      Max_Line_Length : constant Natural := 78;
457

458
      function Are_There_More_Words return Boolean;
459
      --  This function returns True if there are words in the buffer
460

461
      function Next_Word_Length return Natural;
462
      --  This function returns the size of the next word to be
463
      --  got. It returns zero when the buffer is empty.
464

465
      function Get_Next_Word return String;
466
      --  This function extracts the next word from the buffer
467

468
      procedure Skip_Next_Word;
469
      --  Skips the next word
470

471
      --------------------------
472
      -- Are_There_More_Words --
473
      --------------------------
474

475 1
      function Are_There_More_Words return Boolean is
476
      begin
477 1
         return (Name_Len /= 0);
478
      end Are_There_More_Words;
479

480
      ----------------------
481
      -- Next_Word_Length --
482
      ----------------------
483

484 1
      function Next_Word_Length return Natural is
485 1
         L : Natural;
486
      begin
487 1
         if not Are_There_More_Words then
488 0
            L := 0;
489 1
         elsif Name_Buffer (1) = ' ' then
490 1
            L := 1;
491
         else
492 1
            L := 0;
493 1
            while L + 1 <= Name_Len and then Name_Buffer (L + 1) /= ' ' loop
494 1
               L := L + 1;
495 1
            end loop;
496
         end if;
497 1
         return L;
498
      end Next_Word_Length;
499

500
      -------------------
501
      -- Get_Next_Word --
502
      -------------------
503

504 1
      function Get_Next_Word return String is
505 1
         L : constant Natural := Next_Word_Length;
506
      begin
507 1
         if L = 0 then
508 0
            return "";
509
         else
510 1
            declare
511 1
               Next_Word : constant String := Name_Buffer (1 .. L);
512
            begin
513 1
               if Name_Len = L then
514 1
                  Name_Len := 0;
515
               else
516 1
                  Set_Str_To_Name_Buffer (Name_Buffer (L + 1 .. Name_Len));
517
               end if;
518 1
               return Next_Word;
519
            end;
520
         end if;
521
      end Get_Next_Word;
522

523
      --------------------
524
      -- Skip_Next_Word --
525
      --------------------
526

527 1
      procedure Skip_Next_Word is
528
      begin
529 1
         if Name_Len = Next_Word_Length then
530 0
            Name_Len := 0;
531 1
         elsif Next_Word_Length > 0 then
532 1
            Set_Str_To_Name_Buffer
533 1
              (Name_Buffer (Next_Word_Length + 1 .. Name_Len));
534
         end if;
535 1
      end Skip_Next_Word;
536

537 1
      First_Line   : Boolean := True;
538 1
      Used_Columns : Natural;
539
   begin
540 1
      Get_Name_String (Name (Defining_Identifier (N)));
541

542 1
      while Are_There_More_Words loop
543 1
         Used_Columns := N_Space;
544 1
         if First_Line then
545 1
            First_Line := False;
546
         else
547 1
            Write_Indentation;
548
         end if;
549

550
         --  We consume 4 colums
551

552 1
         Used_Columns := Used_Columns + 2;
553 1
         Write_Str ("--");
554

555 1
         if Has_Header_Spaces (N) then
556 1
            Used_Columns := Used_Columns + 2;
557 1
            Write_Str ("  ");
558
         end if;
559

560
         --  If the first word of the line, would be a space, skip it
561

562 1
         if Next_Word_Length = 1 and then Name_Buffer (1) = ' ' then
563 1
            Skip_Next_Word;
564
         end if;
565

566 1
         Used_Columns := Used_Columns + Next_Word_Length;
567 1
         Write_Str (Get_Next_Word);
568

569 1
         while Are_There_More_Words
570 1
           and then (Used_Columns + Next_Word_Length < Max_Line_Length)
571
         loop
572 1
            Used_Columns := Used_Columns + Next_Word_Length;
573 1
            Write_Str (Get_Next_Word);
574 1
         end loop;
575

576 1
         if Are_There_More_Words then
577 1
            Write_Eol;
578
         end if;
579 1
      end loop;
580 1
   end Generate_Ada_Comment;
581

582
   ----------------------------
583
   -- Generate_Unit_Packages --
584
   ----------------------------
585

586 1
   procedure Generate_Unit_Packages (N : Node_Id) is
587 1
      P : Node_Id := First_Node (Packages (N));
588
   begin
589 1
      while Present (P) loop
590 1
         Generate (P);
591 1
         P := Next_Node (P);
592 1
      end loop;
593 1
   end Generate_Unit_Packages;
594

595
   ------------------------------
596
   -- Generate_Array_Aggregate --
597
   ------------------------------
598

599 1
   procedure Generate_Array_Aggregate (N : Node_Id) is
600 1
      E : Node_Id;
601
   begin
602 1
      Write (Tok_Left_Paren);
603

604 1
      E := First_Node (Elements (N));
605
      loop
606 1
         Generate (E);
607 1
         E := Next_Node (E);
608 1
         exit when No (E);
609 1
         Write (Tok_Comma);
610 1
         Write_Eol;
611 1
         Write_Indentation;
612 1
      end loop;
613

614 1
      Write (Tok_Right_Paren);
615 1
   end Generate_Array_Aggregate;
616

617
   ------------------------------------
618
   -- Generate_Array_Type_Definition --
619
   ------------------------------------
620

621 1
   procedure Generate_Array_Type_Definition (N : Node_Id) is
622 1
      R : Node_Id;
623

624
   begin
625 1
      Write (Tok_Array);
626 1
      Write_Space;
627 1
      Write (Tok_Left_Paren);
628 1
      R := First_Node (Range_Constraints (N));
629
      loop
630 1
         Generate (R);
631 1
         R := Next_Node (R);
632 1
         exit when No (R);
633 0
         Write (Tok_Comma);
634 0
         Write_Space;
635 0
      end loop;
636 1
      Write (Tok_Right_Paren);
637 1
      Write_Eol;
638 1
      Increment_Indentation;
639 1
      Write_Indentation (-1);
640 1
      Write (Tok_Of);
641 1
      Write_Space;
642

643 1
      if Aliased_Present (N) then
644 0
         Write (Tok_Aliased);
645 0
         Write_Space;
646
      end if;
647

648 1
      Generate (Component_Definition (N));
649 1
      Decrement_Indentation;
650 1
   end Generate_Array_Type_Definition;
651

652
   -----------------------------------
653
   -- Generate_Assignment_Statement --
654
   -----------------------------------
655

656 1
   procedure Generate_Assignment_Statement (N : Node_Id) is
657
   begin
658 1
      Generate (Defining_Identifier (N));
659 1
      Write_Space;
660 1
      Write (Tok_Colon_Equal);
661 1
      Write_Eol;
662 1
      Increment_Indentation;
663 1
      Write_Indentation (-1);
664 1
      Generate (Expression (N));
665 1
      Decrement_Indentation;
666 1
   end Generate_Assignment_Statement;
667

668
   ------------------------------------------
669
   -- Generate_Attribute_Definition_Clause --
670
   ------------------------------------------
671

672 1
   procedure Generate_Attribute_Definition_Clause (N : Node_Id) is
673
   begin
674 1
      Write (Tok_For);
675 1
      Write_Space;
676 1
      Write_Name (Name (Defining_Identifier (N)));
677 1
      Write (Tok_Apostrophe);
678 1
      Write_Name (Attribute_Designator (N));
679 1
      Write_Space;
680 1
      Write (Tok_Use);
681 1
      Write_Space;
682 1
      Generate (Expression (N));
683 1
   end Generate_Attribute_Definition_Clause;
684

685
   -----------------------------------
686
   -- Generate_Attribute_Designator --
687
   -----------------------------------
688

689 1
   procedure Generate_Attribute_Designator (N : Node_Id) is
690
   begin
691 1
      Generate (Prefix (N));
692 1
      Write (Tok_Apostrophe);
693 1
      Write_Name (Name (N));
694 1
   end Generate_Attribute_Designator;
695

696
   ------------------------------
697
   -- Generate_Block_Statement --
698
   ------------------------------
699

700 0
   procedure Generate_Block_Statement (N : Node_Id) is
701 0
      D : Node_Id;
702
   begin
703 0
      if Present (Defining_Identifier (N)) then
704 0
         Write_Eol;
705 0
         Decrement_Indentation;
706 0
         Write_Indentation (-1);
707 0
         Increment_Indentation;
708 0
         Generate (Defining_Identifier (N));
709 0
         Write_Line (Tok_Colon);
710 0
         Write_Indentation;
711
      end if;
712

713 0
      if not Is_Empty (Declarative_Part (N)) then
714 0
         Write (Tok_Declare);
715 0
         Write_Eol;
716 0
         Increment_Indentation;
717 0
         D := First_Node (Declarative_Part (N));
718
         loop
719 0
            Write_Indentation;
720 0
            Generate (D);
721 0
            Generate_Statement_Delimiter (D);
722 0
            D := Next_Node (D);
723 0
            exit when No (D);
724 0
         end loop;
725 0
         Decrement_Indentation;
726 0
         Write_Indentation;
727
      end if;
728 0
      Write (Tok_Begin);
729 0
      Write_Eol;
730 0
      Increment_Indentation;
731 0
      D := First_Node (Statements (N));
732
      loop
733 0
         Write_Indentation;
734 0
         Generate (D);
735 0
         Generate_Statement_Delimiter (D);
736 0
         D := Next_Node (D);
737 0
         exit when No (D);
738 0
      end loop;
739 0
      Decrement_Indentation;
740 0
      Write_Indentation;
741 0
      if not Is_Empty (Exception_Handler (N)) then
742
         declare
743 0
            Excp_Handler_Alternative : Node_Id;
744
         begin
745 0
            Write (Tok_Exception);
746 0
            Write_Eol;
747 0
            Increment_Indentation;
748

749
            --  Generation of the exception handler
750

751 0
            Write_Indentation;
752 0
            Excp_Handler_Alternative := First_Node (Exception_Handler (N));
753 0
            while Present (Excp_Handler_Alternative) loop
754 0
               Write (Tok_When);
755 0
               Write_Space;
756

757
               --  Generate the different part of the component
758
               --  association but add a new line after "=>"
759

760 0
               Generate (Defining_Identifier (Excp_Handler_Alternative));
761 0
               Write_Space;
762 0
               Write (Tok_Arrow);
763 0
               Write_Eol;
764 0
               Increment_Indentation;
765 0
               Write_Indentation;
766 0
               Generate (Expression (Excp_Handler_Alternative));
767 0
               Generate_Statement_Delimiter
768 0
                 (Expression (Excp_Handler_Alternative));
769 0
               Decrement_Indentation;
770

771
               Excp_Handler_Alternative :=
772 0
                 Next_Node (Excp_Handler_Alternative);
773 0
            end loop;
774 0
            Decrement_Indentation;
775 0
            Write_Indentation;
776
         end;
777
      end if;
778 0
      Write (Tok_End);
779 0
   end Generate_Block_Statement;
780

781
   -------------------------
782
   -- Generate_Case_Label --
783
   -------------------------
784

785 0
   procedure Generate_Case_Label (N : Node_Id) is
786
   begin
787 0
      Write_Str (Image (Value (N)));
788 0
   end Generate_Case_Label;
789

790
   -----------------------------
791
   -- Generate_Case_Statement --
792
   -----------------------------
793

794 1
   procedure Generate_Case_Statement (N : Node_Id) is
795 1
      D : Node_Id;
796 1
      M : Node_Id;
797
   begin
798 1
      Write (Tok_Case);
799 1
      Write_Space;
800 1
      Generate (Expression (N));
801 1
      Write_Space;
802 1
      Write_Line (Tok_Is);
803 1
      D := First_Node (Case_Statement_Alternatives (N));
804 1
      Increment_Indentation;
805

806 1
      while Present (D) loop
807 1
         if Is_Empty (Discret_Choice_List (D)) then
808 1
            Write_Indentation;
809 1
            Generate_Pragma_Warnings (W_Off);
810 1
            Write_Line (Tok_Semicolon);
811
         end if;
812

813 1
         Write_Indentation;
814 1
         Write (Tok_When);
815 1
         Write_Space;
816

817 1
         if not Is_Empty (Discret_Choice_List (D)) then
818 1
            M := First_Node (Discret_Choice_List (D));
819
            loop
820 1
               Generate (M);
821 1
               M := Next_Node (M);
822 1
               exit when No (M);
823 1
               Write_Space;
824 1
               Write (Tok_Vertical_Bar);
825 1
               Write_Space;
826 1
            end loop;
827 1
            Write_Space;
828 1
            Write_Line (Tok_Arrow);
829
         else
830 1
            Write (Tok_Others);
831 1
            Write_Space;
832 1
            Write_Line (Tok_Arrow);
833
         end if;
834

835 1
         Increment_Indentation;
836

837 1
         if Is_Empty (Statements (D)) then
838 1
            Write_Indentation;
839 1
            Write (Tok_Null);
840 1
            Write_Line (Tok_Semicolon);
841
         else
842 1
            M := First_Node (Statements (D));
843 1
            while Present (M) loop
844 1
               Write_Indentation;
845 1
               Generate (M);
846 1
               Generate_Statement_Delimiter (M);
847 1
               M := Next_Node (M);
848 1
            end loop;
849
         end if;
850

851 1
         Decrement_Indentation;
852

853 1
         if Is_Empty (Discret_Choice_List (D)) then
854 1
            Write_Indentation;
855 1
            Generate_Pragma_Warnings (W_On);
856 1
            Write_Line (Tok_Semicolon);
857
         end if;
858

859 1
         Write_Eol;
860

861 1
         D := Next_Node (D);
862 1
      end loop;
863 1
      Decrement_Indentation;
864 1
      Write_Indentation;
865 1
      Write (Tok_End);
866 1
      Write_Space;
867 1
      Write (Tok_Case);
868 1
   end Generate_Case_Statement;
869

870
   ------------------------------------
871
   -- Generate_Component_Association --
872
   ------------------------------------
873

874 1
   procedure Generate_Component_Association (N : Node_Id) is
875
   begin
876
      --  If the developer gives a defining identifier, we generate
877
      --  it, else we assume that the developer wants to generate a
878
      --  "others => ..." statement.
879

880 1
      if Present (Defining_Identifier (N)) then
881 1
         Generate (Defining_Identifier (N));
882
      else
883 0
         Write (Tok_Others);
884
      end if;
885

886 1
      Write_Space;
887 1
      Write (Tok_Arrow);
888 1
      Write_Space;
889 1
      Generate (Expression (N));
890 1
   end Generate_Component_Association;
891

892
   ------------------------------------
893
   -- Generate_Component_Declaration --
894
   ------------------------------------
895

896 1
   procedure Generate_Component_Declaration (N : Node_Id) is
897 1
      E : constant Node_Id := Expression (N);
898

899
   begin
900 1
      Generate (Defining_Identifier (N));
901 1
      Write_Space;
902 1
      Write (Tok_Colon);
903 1
      Write_Space;
904

905 1
      if Aliased_Present (N) then
906 0
         Write (Tok_Aliased);
907 0
         Write_Space;
908
      end if;
909

910 1
      Generate (Subtype_Indication (N));
911

912 1
      if Present (E) then
913 1
         Write_Space;
914 1
         Write (Tok_Colon_Equal);
915 1
         Write_Space;
916 1
         Generate (E);
917
      end if;
918 1
   end Generate_Component_Declaration;
919

920
   --------------------------------------
921
   -- Generate_Decimal_Type_Definition --
922
   --------------------------------------
923

924 1
   procedure Generate_Decimal_Type_Definition (N : Node_Id) is
925
   begin
926 1
      Write (Tok_Delta);
927 1
      Write_Space;
928

929 1
      Generate (Scale (N));
930 1
      Write_Space;
931

932 1
      Write (Tok_Digits);
933 1
      Write_Space;
934

935 1
      Write_Str (Image (Total (N)));
936

937 1
   end Generate_Decimal_Type_Definition;
938

939
   ----------------------------------
940
   -- Generate_Defining_Identifier --
941
   ----------------------------------
942

943 1
   procedure Generate_Defining_Identifier (N : Node_Id) is
944 1
      P : Node_Id;
945

946
   begin
947 1
      P := Parent_Unit_Name (N);
948

949 1
      if Present (P) then
950 1
         Generate (P);
951 1
         Write (Tok_Dot);
952
      end if;
953

954 1
      Write_Name (Name (N));
955 1
   end Generate_Defining_Identifier;
956

957
   ------------------------------
958
   -- Generate_Delay_Statement --
959
   ------------------------------
960

961 0
   procedure Generate_Delay_Statement (N : Node_Id) is
962
   begin
963 0
      Write (Tok_Delay);
964 0
      Write_Space;
965

966 0
      if Is_Until (N) then
967 0
         Write (Tok_Until);
968 0
         Write_Space;
969
      end if;
970

971 0
      Generate (Expression (N));
972 0
   end Generate_Delay_Statement;
973

974
   --------------------------------------
975
   -- Generate_Derived_Type_Definition --
976
   --------------------------------------
977

978 1
   procedure Generate_Derived_Type_Definition (N : Node_Id) is
979 1
      R : Node_Id;
980

981
   begin
982 1
      if Is_Abstract_Type (N) then
983 0
         Write (Tok_Abstract);
984 0
         Write_Space;
985
      end if;
986

987 1
      if not Is_Subtype (N) then
988 1
         Write (Tok_New);
989 1
         Write_Space;
990
      end if;
991 1
      Generate (Subtype_Indication (N));
992

993 1
      if Is_Private_Extention (N) then
994 0
         Write_Space;
995 0
         Write (Tok_With);
996 0
         Write_Space;
997 0
         Write (Tok_Private);
998
      else
999 1
         R := Record_Extension_Part (N);
1000

1001 1
         if Present (R) then
1002 0
            Write_Space;
1003 0
            Write (Tok_With);
1004 0
            Write_Space;
1005 0
            Generate (Record_Extension_Part (N));
1006
         end if;
1007
      end if;
1008 1
   end Generate_Derived_Type_Definition;
1009

1010
   -------------------------
1011
   -- Generate_Designator --
1012
   -------------------------
1013

1014 1
   procedure Generate_Designator (N : Node_Id) is
1015 1
      P : Node_Id;
1016

1017
   begin
1018 1
      P := Parent_Unit_Name (N);
1019

1020 1
      if Present (P) then
1021 1
         Generate (P);
1022 1
         Write (Tok_Dot);
1023
      end if;
1024

1025 1
      Write_Name (Name (Defining_Identifier (N)));
1026

1027 1
      if Is_All (N) then
1028 0
         Write (Tok_Dot);
1029 0
         Write (Tok_All);
1030
      end if;
1031 1
   end Generate_Designator;
1032

1033
   ----------------------------------
1034
   -- Generate_Element_Association --
1035
   ----------------------------------
1036

1037 1
   procedure Generate_Element_Association (N : Node_Id) is
1038
   begin
1039 1
      if Present (Index (N)) then
1040 1
         Generate (Index (N));
1041
      else
1042 1
         Write (Tok_Others);
1043
      end if;
1044

1045 1
      Write_Space;
1046 1
      Write (Tok_Arrow);
1047 1
      Write_Eol;
1048

1049 1
      Increment_Indentation;
1050 1
      Write_Indentation (-1);
1051 1
      Generate (Expression (N));
1052 1
      Decrement_Indentation;
1053 1
   end Generate_Element_Association;
1054

1055
   ------------------------------
1056
   -- Generate_Elsif_Statement --
1057
   ------------------------------
1058

1059 1
   procedure Generate_Elsif_Statement (N : Node_Id) is
1060 1
      D : Node_Id;
1061
   begin
1062 1
      if No (First_Node (Then_Statements (N))) then
1063 0
         return;
1064
      end if;
1065

1066 1
      Write (Tok_Elsif);
1067 1
      Write_Space;
1068 1
      Generate (Condition (N));
1069 1
      Write_Eol;
1070 1
      Write_Indentation;
1071 1
      Write_Line (Tok_Then);
1072 1
      Increment_Indentation;
1073 1
      D := First_Node (Then_Statements (N));
1074
      loop
1075 1
         Write_Indentation;
1076 1
         Generate (D);
1077 1
         exit when No (Next_Node (D));
1078 1
         Generate_Statement_Delimiter (D);
1079 1
         D := Next_Node (D);
1080 1
      end loop;
1081 1
      Decrement_Indentation;
1082
   end Generate_Elsif_Statement;
1083

1084
   ------------------------------------------
1085
   -- Generate_Enumeration_Type_Definition --
1086
   ------------------------------------------
1087

1088 1
   procedure Generate_Enumeration_Type_Definition (N : Node_Id) is
1089 1
      E : Node_Id;
1090

1091
   begin
1092 1
      Write (Tok_Left_Paren);
1093 1
      E := First_Node (Enumeration_Literals (N));
1094

1095 1
      while Present (E) loop
1096 1
         Generate (E);
1097 1
         E := Next_Node (E);
1098 1
         exit when No (E);
1099 1
         Write_Line (Tok_Comma);
1100 1
         Write_Indentation;
1101 1
      end loop;
1102

1103 1
      Write (Tok_Right_Paren);
1104 1
   end Generate_Enumeration_Type_Definition;
1105

1106
   ------------------------------------------------
1107
   -- Generate_Enumeration_Representation_Clause --
1108
   ------------------------------------------------
1109

1110 1
   procedure Generate_Enumeration_Representation_Clause (N : Node_Id) is
1111
   begin
1112 1
      Write (Tok_For);
1113 1
      Write_Space;
1114 1
      Generate (Defining_Identifier (N));
1115 1
      Write_Space;
1116 1
      Write (Tok_Use);
1117 1
      Write_Eol;
1118 1
      Increment_Indentation;
1119 1
      Write_Indentation (-1);
1120 1
      Generate (Array_Aggregate (N));
1121 1
      Decrement_Indentation;
1122 1
   end Generate_Enumeration_Representation_Clause;
1123

1124
   ------------------------------------
1125
   -- Generate_Exception_Declaration --
1126
   ------------------------------------
1127

1128 1
   procedure Generate_Exception_Declaration (N : Node_Id) is
1129
   begin
1130 1
      Write_Name (Name (Defining_Identifier (N)));
1131 1
      Write_Space;
1132 1
      Write (Tok_Colon);
1133 1
      Write_Space;
1134 1
      Write (Tok_Exception);
1135 1
      if Present (Renamed_Entity (N)) then
1136 0
         Write_Eol;
1137 0
         Increment_Indentation;
1138 0
         Write_Indentation (-1);
1139 0
         Write (Tok_Renames);
1140 0
         Write_Space;
1141 0
         Generate (Renamed_Entity (N));
1142 0
         Decrement_Indentation;
1143
      end if;
1144 1
   end Generate_Exception_Declaration;
1145

1146
   -----------------------------------
1147
   -- Generate_Explicit_Dereference --
1148
   -----------------------------------
1149

1150 0
   procedure Generate_Explicit_Dereference (N : Node_Id) is
1151
   begin
1152 0
      Generate (Prefix (N));
1153 0
      Write (Tok_Dot);
1154 0
      Write (Tok_All);
1155 0
   end Generate_Explicit_Dereference;
1156

1157
   -------------------------
1158
   -- Generate_Expression --
1159
   -------------------------
1160

1161 1
   procedure Generate_Expression (N : Node_Id) is
1162 1
      L_Expr : constant Node_Id     := Left_Expr (N);
1163 1
      Op     : constant Operator_Id := Operator (N);
1164 1
      R_Expr : constant Node_Id     := Right_Expr (N);
1165
   begin
1166
      --  Each expression having a right part and a left part is
1167
      --  systematically put between two parentheses.
1168

1169 1
      if No (R_Expr) then
1170 0
         if Op = Operator_Type'Pos (Op_Not) then
1171 0
            Write (Tok_Not);
1172 0
            Write_Space;
1173 0
         elsif Op /= Operator_Type'Pos (Op_None) then
1174 0
            Write_Name (Operator_Image (Standard.Integer (Op)));
1175

1176
            --  Do not generate space after a unary operator
1177
         end if;
1178
      else
1179
         --  Expressions having "|" as operator (case switches
1180
         --  alternatives) and expressions having "&" as operator
1181
         --  (array concatenation) do not require parentheses.
1182

1183 1
         if Op /= Operator_Type'Pos (Op_Vertical_Bar)
1184 1
           and then Op /= Operator_Type'Pos (Op_And_Symbol)
1185
         then
1186 1
            Write (Tok_Left_Paren);
1187
         end if;
1188
      end if;
1189

1190 1
      Generate (L_Expr);
1191

1192 1
      if Present (R_Expr) then
1193 1
         Write_Eol;
1194 1
         Increment_Indentation;
1195 1
         Write_Indentation;
1196

1197 1
         Write_Name (Operator_Image (Standard.Integer (Op)));
1198 1
         Write_Space;
1199 1
         Generate (R_Expr);
1200

1201 1
         if Op /= Operator_Type'Pos (Op_Vertical_Bar)
1202 1
           and then Op /= Operator_Type'Pos (Op_And_Symbol)
1203
         then
1204 1
            Write (Tok_Right_Paren);
1205
         end if;
1206

1207 1
         Decrement_Indentation;
1208
      end if;
1209 1
   end Generate_Expression;
1210

1211
   ----------------------------
1212
   -- Generate_For_Statement --
1213
   ----------------------------
1214

1215 0
   procedure Generate_For_Statement (N : Node_Id) is
1216 0
      D : Node_Id := First_Node (Statements (N));
1217
   begin
1218 0
      Write (Tok_For);
1219 0
      Write_Space;
1220 0
      Write_Name (Name (Defining_Identifier (N)));
1221 0
      Write_Space;
1222 0
      Write (Tok_In);
1223 0
      Write_Space;
1224 0
      Generate (First (Range_Constraint (N)));
1225 0
      Write_Space;
1226 0
      Write (Tok_Dot);
1227 0
      Write (Tok_Dot);
1228 0
      Write_Space;
1229 0
      Generate (Last (Range_Constraint (N)));
1230 0
      Write_Space;
1231 0
      Write (Tok_Loop);
1232 0
      Write_Eol;
1233 0
      Increment_Indentation;
1234 0
      while Present (D) loop
1235 0
         Write_Indentation;
1236 0
         Generate (D);
1237 0
         Generate_Statement_Delimiter (D);
1238 0
         D := Next_Node (D);
1239 0
      end loop;
1240 0
      Decrement_Indentation;
1241 0
      Write_Indentation;
1242 0
      Write (Tok_End);
1243 0
      Write_Space;
1244 0
      Write (Tok_Loop);
1245 0
   end Generate_For_Statement;
1246

1247
   ------------------------------------
1248
   -- Generate_Full_Type_Declaration --
1249
   ------------------------------------
1250

1251 1
   procedure Generate_Full_Type_Declaration (N : Node_Id) is
1252 1
      D : constant Node_Id := Discriminant_Spec (N);
1253

1254
   begin
1255 1
      if Is_Subtype (N) then
1256 1
         Write (Tok_Subtype);
1257
      else
1258 1
         Write (Tok_Type);
1259
      end if;
1260 1
      Write_Space;
1261 1
      Write_Name (Name (Defining_Identifier (N)));
1262 1
      Write_Space;
1263

1264 1
      if Present (D) then
1265 1
         Write_Eol;
1266 1
         Increment_Indentation;
1267 1
         Write_Indentation (-1);
1268 1
         Write (Tok_Left_Paren);
1269 1
         Generate (D);
1270 1
         Write (Tok_Right_Paren);
1271 1
         Decrement_Indentation;
1272 1
         Write_Eol;
1273 1
         Write_Indentation;
1274
      end if;
1275

1276 1
      if Type_Definition (N) /= No_Node then
1277 1
         Write (Tok_Is);
1278 1
         Write_Eol;
1279 1
         Increment_Indentation;
1280 1
         Write_Indentation (-1);
1281 1
         Generate (Type_Definition (N));
1282 1
         Decrement_Indentation;
1283
      else
1284 0
         Write_Eol;
1285
      end if;
1286 1
   end Generate_Full_Type_Declaration;
1287

1288
   ---------------------------
1289
   -- Generate_If_Statement --
1290
   ---------------------------
1291

1292 1
   procedure Generate_If_Statement (N : Node_Id) is
1293 1
      T : constant List_Id := Then_Statements (N);
1294 1
      E : constant List_Id := Else_Statements (N);
1295 1
      I : Node_Id;
1296

1297
   begin
1298
      --  Enter If_Statement
1299

1300 1
      Write (Tok_If);
1301 1
      Write_Space;
1302 1
      Generate (Condition (N));
1303 1
      Write_Eol;
1304 1
      Write_Indentation;
1305 1
      Write (Tok_Then);
1306 1
      Write_Eol;
1307

1308
      --  If_Statement cannot be empty. A null statement is always
1309
      --  there if needed.
1310

1311 1
      Increment_Indentation;
1312 1
      I := First_Node (T);
1313 1
      while Present (I) loop
1314 1
         Write_Indentation;
1315 1
         Generate (I);
1316 1
         Generate_Statement_Delimiter (I);
1317 1
         I := Next_Node (I);
1318 1
      end loop;
1319 1
      Decrement_Indentation;
1320

1321
      --  Elsif_Statements
1322

1323 1
      if not Is_Empty (Elsif_Statements (N)) then
1324 1
         I := First_Node (Elsif_Statements (N));
1325
         loop
1326 1
            Write_Indentation;
1327 1
            Generate (I);
1328 1
            Generate_Statement_Delimiter (I);
1329 1
            I := Next_Node (I);
1330 1
            exit when No (I);
1331 1
         end loop;
1332
      end if;
1333

1334
      --  Else_Statement can be empty
1335

1336 1
      if not Is_Empty (E) then
1337 1
         Write_Indentation;
1338 1
         Write (Tok_Else);
1339 1
         Write_Eol;
1340 1
         Increment_Indentation;
1341 1
         I := First_Node (E);
1342 1
         while Present (I) loop
1343 1
            Write_Indentation;
1344 1
            Generate (I);
1345 1
            Generate_Statement_Delimiter (I);
1346 1
            I := Next_Node (I);
1347 1
         end loop;
1348 1
         Decrement_Indentation;
1349
      end if;
1350

1351
      --  Leave If_Statement
1352

1353 1
      Write_Indentation;
1354 1
      Write (Tok_End);
1355 1
      Write_Space;
1356 1
      Write (Tok_If);
1357 1
   end Generate_If_Statement;
1358

1359
   ----------------------------------
1360
   -- Generate_Exit_When_Statement --
1361
   ----------------------------------
1362

1363 0
   procedure Generate_Exit_When_Statement (N : Node_Id) is
1364
   begin
1365 0
      Write (Tok_Exit);
1366 0
      Write_Space;
1367 0
      Write (Tok_When);
1368 0
      Write_Space;
1369

1370
      --  print the condition condition
1371

1372 0
      Generate (Condition (N));
1373 0
   end Generate_Exit_When_Statement;
1374

1375
   --------------------------------
1376
   -- Generate_Indexed_Component --
1377
   --------------------------------
1378

1379 1
   procedure Generate_Indexed_Component (N : Node_Id) is
1380 1
      Exp : constant List_Id := Expressions (N);
1381 1
      E   : Node_Id;
1382
   begin
1383 1
      Generate (Prefix (N));
1384

1385 1
      pragma Assert (not Is_Empty (Exp));
1386

1387 1
      Write_Eol;
1388 1
      Increment_Indentation;
1389 1
      Write_Indentation (-1);
1390 1
      Write (Tok_Left_Paren);
1391 1
      E := First_Node (Exp);
1392

1393
      loop
1394 1
         Generate (E);
1395 1
         E := Next_Node (E);
1396 1
         exit when No (E);
1397 0
         Write_Line (Tok_Comma);
1398 0
         Write_Indentation;
1399 0
      end loop;
1400

1401 1
      Write (Tok_Right_Paren);
1402 1
      Decrement_Indentation;
1403 1
   end Generate_Indexed_Component;
1404

1405
   ----------------------
1406
   -- Generate_Literal --
1407
   ----------------------
1408

1409 1
   procedure Generate_Literal (N : Node_Id) is
1410
   begin
1411 1
      if Present (Parent_Designator (N)) then
1412 0
         Generate (Parent_Designator (N));
1413 0
         Write (Tok_Dot);
1414
      end if;
1415 1
      Write_Str (Image (Value (N)));
1416 1
   end Generate_Literal;
1417

1418
   -----------------------------
1419
   -- Generate_Loop_Statement --
1420
   -----------------------------
1421

1422 0
   procedure Generate_Loop_Statement (N : Node_Id) is
1423 0
      D : Node_Id := First_Node (Statements (N));
1424
   begin
1425 0
      Write (Tok_Loop);
1426 0
      Write_Eol;
1427 0
      Increment_Indentation;
1428 0
      while Present (D) loop
1429 0
         Write_Indentation;
1430 0
         Generate (D);
1431 0
         Generate_Statement_Delimiter (D);
1432 0
         D := Next_Node (D);
1433 0
      end loop;
1434 0
      Decrement_Indentation;
1435 0
      Write_Indentation;
1436 0
      Write (Tok_End);
1437 0
      Write_Space;
1438 0
      Write (Tok_Loop);
1439 0
   end Generate_Loop_Statement;
1440

1441
   ---------------------------------------------
1442
   -- Generate_Main_Subprogram_Implementation --
1443
   ---------------------------------------------
1444

1445 1
   procedure Generate_Main_Subprogram_Implementation (N : Node_Id) is
1446 1
      Fd : File_Descriptor;
1447
   begin
1448 1
      if Present (Subprogram_Specification (N)) then
1449 0
         Fd := Set_Output (Get_File_Name (Subprogram_Specification (N)));
1450 0
         Generate (Subprogram_Specification (N));
1451 0
         Generate_Statement_Delimiter (Subprogram_Specification (N));
1452 0
         Release_Output (Fd);
1453
      end if;
1454

1455 1
      if Present (Subprogram_Implementation (N)) then
1456 1
         Fd := Set_Output (Get_File_Name (Subprogram_Implementation (N)));
1457 1
         Generate (Subprogram_Implementation (N));
1458 1
         Generate_Statement_Delimiter (Subprogram_Implementation (N));
1459 1
         Release_Output (Fd);
1460
      end if;
1461 1
   end Generate_Main_Subprogram_Implementation;
1462

1463
   -----------------------------
1464
   -- Generate_Null_Statement --
1465
   -----------------------------
1466

1467 1
   procedure Generate_Null_Statement is
1468
   begin
1469 1
      Write (Tok_Null);
1470 1
   end Generate_Null_Statement;
1471

1472
   ---------------------------------
1473
   -- Generate_Object_Declaration --
1474
   ---------------------------------
1475

1476 1
   procedure Generate_Object_Declaration (N : Node_Id) is
1477
   begin
1478 1
      Name_Buffer (1 .. Var_Name_Len) := (others => ' ');
1479 1
      Get_Name_String (Name (Defining_Identifier (N)));
1480

1481 1
      if Var_Name_Len > Name_Len then
1482 0
         Name_Len := Var_Name_Len;
1483
      end if;
1484

1485 1
      Write_Str (Name_Buffer (1 .. Name_Len));
1486 1
      Write_Space;
1487 1
      Write (Tok_Colon);
1488

1489 1
      if Constant_Present (N) then
1490 1
         Write_Space;
1491 1
         Write (Tok_Constant);
1492
      end if;
1493

1494 1
      if Aliased_Present (N) then
1495 0
         Write_Space;
1496 0
         Write (Tok_Aliased);
1497
      end if;
1498

1499 1
      Write_Space;
1500 1
      if Present (Object_Definition (N)) then
1501 1
         Generate (Object_Definition (N));
1502
      else
1503
         --  This workaround doesn't affect the classic object
1504
         --  declaration because we must give a type. However it makes
1505
         --  the generation of case statement and exception handlers
1506
         --  simpler.
1507

1508 0
         Write (Tok_Others);
1509
      end if;
1510

1511 1
      if Present (Discriminant_Spec (N)) then
1512 0
         Write_Eol;
1513 0
         Increment_Indentation;
1514 0
         Write_Indentation (-1);
1515 0
         Generate (Discriminant_Spec (N));
1516 0
         Decrement_Indentation;
1517
      end if;
1518

1519 1
      if Present (Renamed_Entity (N)) then
1520 0
         Write_Eol;
1521 0
         Increment_Indentation;
1522 0
         Write_Indentation (-1);
1523 0
         Write (Tok_Renames);
1524 0
         Write_Space;
1525 0
         Generate (Renamed_Entity (N));
1526 0
         Decrement_Indentation;
1527

1528
      --  If an object renames another object, it cannot be
1529
      --  initialized,
1530
      else
1531 1
         if Present (Expression (N)) then
1532 1
            Write_Space;
1533 1
            Write (Tok_Colon_Equal);
1534 1
            Write_Eol;
1535 1
            Increment_Indentation;
1536 1
            Write_Indentation (-1);
1537 1
            Generate (Expression (N));
1538 1
            Decrement_Indentation;
1539
         end if;
1540
      end if;
1541 1
   end Generate_Object_Declaration;
1542

1543
   -----------------------------------
1544
   -- Generate_Object_Instantiation --
1545
   -----------------------------------
1546

1547 0
   procedure Generate_Object_Instantiation (N : Node_Id) is
1548
   begin
1549 0
      Write (Tok_New);
1550 0
      Write_Space;
1551 0
      Generate (Qualified_Expression (N));
1552 0
   end Generate_Object_Instantiation;
1553

1554
   ----------------------------------
1555
   -- Generate_Package_Declaration --
1556
   ----------------------------------
1557

1558 1
   procedure Generate_Package_Declaration (N : Node_Id) is
1559
   begin
1560 1
      Generate (Package_Specification (N));
1561 1
      Generate (Package_Implementation (N));
1562 1
   end Generate_Package_Declaration;
1563

1564
   -------------------------------------
1565
   -- Generate_Package_Implementation --
1566
   -------------------------------------
1567

1568 1
   procedure Generate_Package_Implementation (N : Node_Id) is
1569 1
      P  : Node_Id;
1570 1
      Fd : File_Descriptor;
1571
   begin
1572
      --  If the user wants to generates only the spec, or if the
1573
      --  package body is empty, we don't generate it.
1574

1575 1
      if Disable_Pkg_Body_Gen or else Is_Empty (Statements (N)) then
1576 1
         return;
1577
      end if;
1578

1579 1
      Fd := Set_Output (Get_File_Name (N));
1580

1581
      --  generate Package Headers : comment headers and pragma
1582

1583 1
      P := First_Node (Package_Headers (N));
1584 1
      while Present (P) loop
1585 1
         Write_Indentation;
1586 1
         Generate (P);
1587 1
         Generate_Statement_Delimiter (P);
1588 1
         P := Next_Node (P);
1589 1
      end loop;
1590 1
      Write_Eol;
1591

1592 1
      P := First_Node (Withed_Packages (N));
1593 1
      while Present (P) loop
1594 1
         Write_Indentation;
1595 1
         Generate (P);
1596 1
         Generate_Statement_Delimiter (P);
1597 1
         P := Next_Node (P);
1598 1
      end loop;
1599 1
      Write_Eol;
1600

1601 1
      Write_Indentation;
1602 1
      Write (Tok_Package);
1603 1
      Write_Space;
1604 1
      Write (Tok_Body);
1605 1
      Write_Space;
1606 1
      Generate (Defining_Identifier (Package_Declaration (N)));
1607 1
      Write_Space;
1608

1609 1
      Generate_Aspect (Aspect_Specification (N));
1610

1611 1
      Write (Tok_Is);
1612 1
      Write_Eol (2);
1613

1614 1
      Increment_Indentation;
1615 1
      P := First_Node (Statements (N));
1616 1
      while Present (P) loop
1617 1
         Write_Indentation;
1618 1
         Generate (P);
1619 1
         Generate_Statement_Delimiter (P);
1620 1
         Write_Eol;
1621 1
         P := Next_Node (P);
1622 1
      end loop;
1623 1
      Decrement_Indentation;
1624 1
      Write_Indentation;
1625

1626 1
      if not Is_Empty (Package_Initialization (N)) then
1627 0
         Write_Line (Tok_Begin);
1628 0
         Increment_Indentation;
1629 0
         P := First_Node (Package_Initialization (N));
1630
         loop
1631 0
            Write_Indentation;
1632 0
            Generate (P);
1633 0
            Generate_Statement_Delimiter (P);
1634 0
            P := Next_Node (P);
1635 0
            exit when No (P);
1636 0
         end loop;
1637 0
         Decrement_Indentation;
1638 0
         Write_Indentation;
1639
      end if;
1640

1641 1
      Write (Tok_End);
1642 1
      Write_Space;
1643 1
      Generate (Defining_Identifier (Package_Declaration (N)));
1644 1
      Generate_Statement_Delimiter
1645 1
        (Defining_Identifier (Package_Declaration (N)));
1646

1647 1
      Release_Output (Fd);
1648
   end Generate_Package_Implementation;
1649

1650
   ------------------------------------
1651
   -- Generate_Package_Instantiation --
1652
   ------------------------------------
1653

1654 1
   procedure Generate_Package_Instantiation (N : Node_Id) is
1655 1
      Param : Node_Id;
1656
   begin
1657 1
      Write (Tok_Package);
1658 1
      Write_Space;
1659 1
      Generate (Defining_Identifier (N));
1660 1
      Write_Space;
1661 1
      Write (Tok_Is);
1662 1
      Write_Eol;
1663 1
      Increment_Indentation;
1664 1
      Write_Indentation (-1);
1665 1
      Write (Tok_New);
1666 1
      Write_Space;
1667 1
      Generate (Generic_Package (N));
1668 1
      if not Is_Empty (Parameter_List (N)) then
1669 1
         Write_Eol;
1670 1
         Increment_Indentation;
1671 1
         Write_Indentation (-1);
1672 1
         Write (Tok_Left_Paren);
1673 1
         Param := First_Node (Parameter_List (N));
1674
         loop
1675 1
            Generate (Param);
1676 1
            Param := Next_Node (Param);
1677 1
            exit when No (Param);
1678 1
            Write_Line (Tok_Comma);
1679 1
            Write_Indentation;
1680 1
         end loop;
1681 1
         Write (Tok_Right_Paren);
1682 1
         Decrement_Indentation;
1683
      end if;
1684 1
      Decrement_Indentation;
1685 1
   end Generate_Package_Instantiation;
1686

1687
   ------------------------------------
1688
   -- Generate_Package_Specification --
1689
   ------------------------------------
1690

1691 1
   procedure Generate_Package_Specification (N : Node_Id) is
1692 1
      P  : Node_Id;
1693 1
      Fd : File_Descriptor;
1694
   begin
1695
      --  If the user wants to generates only the body, or if the
1696
      --  package spec is empty, we don't generate it.
1697

1698 1
      if Disable_Pkg_Spec_Gen then
1699 0
         return;
1700
      end if;
1701

1702
      --  Do not generate empty non instanciated specs
1703

1704 1
      if not Is_Instantiated_Package (N)
1705 1
        and then Is_Empty (Visible_Part (N))
1706 1
        and then Is_Empty (Private_Part (N))
1707
      then
1708 1
         return;
1709
      end if;
1710

1711 1
      Fd := Set_Output (Get_File_Name (N));
1712

1713
      --  generate Package Headers : comment headers and pragma
1714

1715 1
      P := First_Node (Package_Headers (N));
1716 1
      while Present (P) loop
1717 1
         Write_Indentation;
1718 1
         Generate (P);
1719 1
         Generate_Statement_Delimiter (P);
1720 1
         P := Next_Node (P);
1721 1
      end loop;
1722 1
      Write_Eol;
1723

1724 1
      P := First_Node (Withed_Packages (N));
1725 1
      while Present (P) loop
1726 1
         Write_Indentation;
1727 1
         Generate (P);
1728 1
         Generate_Statement_Delimiter (P);
1729 1
         P := Next_Node (P);
1730 1
      end loop;
1731 1
      Write_Eol;
1732

1733 1
      if Is_Instantiated_Package (N) then
1734 0
         Generate (Package_Instantiation (N));
1735 0
         Generate_Statement_Delimiter (Package_Instantiation (N));
1736
      else
1737 1
         Write_Indentation;
1738 1
         Write (Tok_Package);
1739 1
         Write_Space;
1740 1
         Generate (Defining_Identifier (Package_Declaration (N)));
1741

1742 1
         Generate_Aspect (Aspect_Specification (N));
1743 1
         Write_Space;
1744 1
         Write (Tok_Is);
1745 1
         Write_Eol (2);
1746

1747 1
         Increment_Indentation;
1748 1
         P := First_Node (Visible_Part (N));
1749 1
         while Present (P) loop
1750 1
            Write_Indentation;
1751 1
            Generate (P);
1752 1
            Generate_Statement_Delimiter (P);
1753 1
            Write_Eol;
1754 1
            P := Next_Node (P);
1755 1
         end loop;
1756 1
         Decrement_Indentation;
1757

1758 1
         if not Is_Empty (Private_Part (N)) then
1759 1
            Write_Indentation;
1760 1
            Write (Tok_Private);
1761 1
            Write_Eol;
1762 1
            Increment_Indentation;
1763 1
            P := First_Node (Private_Part (N));
1764 1
            while Present (P) loop
1765 1
               Write_Indentation;
1766 1
               Generate (P);
1767 1
               Generate_Statement_Delimiter (P);
1768 1
               Write_Eol;
1769 1
               P := Next_Node (P);
1770 1
            end loop;
1771 1
            Decrement_Indentation;
1772
         end if;
1773

1774 1
         Write_Indentation;
1775 1
         Write (Tok_End);
1776 1
         Write_Space;
1777 1
         Generate (Defining_Identifier (Package_Declaration (N)));
1778 1
         Generate_Statement_Delimiter
1779 1
           (Defining_Identifier (Package_Declaration (N)));
1780
      end if;
1781

1782 1
      Release_Output (Fd);
1783
   end Generate_Package_Specification;
1784

1785
   ------------------------
1786
   -- Generate_Parameter --
1787
   ------------------------
1788

1789 1
   procedure Generate_Parameter (N : Node_Id) is
1790
   begin
1791 1
      Name_Buffer (1 .. Var_Name_Len) := (others => ' ');
1792 1
      Get_Name_String (Name (Defining_Identifier (N)));
1793

1794 1
      if Var_Name_Len > Name_Len then
1795 0
         Name_Len := Var_Name_Len;
1796
      end if;
1797

1798 1
      Write_Str (Name_Buffer (1 .. Name_Len));
1799 1
      Write_Space;
1800 1
      Write (Tok_Colon);
1801 1
      Write_Space;
1802

1803 1
      if Kind (Parameter_Type (N)) /= K_Access_Type_Definition then
1804 1
         case Parameter_Mode (N) is
1805 1
            when Mode_In =>
1806 1
               null;
1807

1808 1
            when Mode_Out =>
1809 1
               Write (Tok_Out);
1810 1
               Write_Space;
1811

1812 1
            when Mode_Inout =>
1813 1
               Write (Tok_In);
1814 1
               Write_Space;
1815 1
               Write (Tok_Out);
1816 1
               Write_Space;
1817 1
         end case;
1818
      end if;
1819

1820 1
      Generate (Parameter_Type (N));
1821

1822 1
      if Present (Expression (N)) then
1823 1
         Write_Space;
1824 1
         Write_Line (Tok_Colon_Equal);
1825 1
         Increment_Indentation;
1826 1
         Write_Indentation;
1827 1
         Generate (Expression (N));
1828 1
         Decrement_Indentation;
1829
      end if;
1830 1
   end Generate_Parameter;
1831

1832
   ------------------------------------
1833
   -- Generate_Parameter_Association --
1834
   ------------------------------------
1835

1836 1
   procedure Generate_Parameter_Association (N : Node_Id) is
1837
   begin
1838 1
      Generate (Selector_Name (N));
1839 1
      Write_Space;
1840 1
      Write (Tok_Arrow);
1841 1
      Write_Space;
1842 1
      Generate (Actual_Parameter (N));
1843 1
   end Generate_Parameter_Association;
1844

1845
   -----------------------------
1846
   -- Generate_Parameter_List --
1847
   -----------------------------
1848

1849 1
   procedure Generate_Parameter_List (L : List_Id) is
1850 1
      N : Node_Id;
1851

1852
   begin
1853
      --  If we got there, then L is not empty.
1854

1855 1
      Increment_Indentation;
1856 1
      Write_Indentation (-1);
1857 1
      Write (Tok_Left_Paren);
1858 1
      N := First_Node (L);
1859
      loop
1860 1
         Generate_Parameter (N);
1861 1
         exit when No (Next_Node (N));
1862 1
         Generate_Statement_Delimiter (N);
1863 1
         Write_Indentation;
1864 1
         N := Next_Node (N);
1865 1
      end loop;
1866 1
      Write (Tok_Right_Paren);
1867 1
      Decrement_Indentation;
1868 1
   end Generate_Parameter_List;
1869

1870
   -------------------------------
1871
   -- Generate_Pragma_Statement --
1872
   -------------------------------
1873

1874 1
   procedure Generate_Pragma_Statement (N : Node_Id) is
1875 1
      Args : constant List_Id := Nodes.Argument_List (N);
1876 1
      Arg  : Node_Id;
1877
   begin
1878 1
      Write (Tok_Pragma);
1879 1
      Write_Space;
1880 1
      Generate (Defining_Identifier (N));
1881

1882 1
      if not Is_Empty (Args) then
1883 1
         Write_Eol;
1884 1
         Increment_Indentation;
1885 1
         Write_Indentation (-1);
1886 1
         Write (Tok_Left_Paren);
1887 1
         Arg := First_Node (Args);
1888
         loop
1889 1
            Generate (Arg);
1890 1
            Arg := Next_Node (Arg);
1891 1
            exit when No (Arg);
1892 1
            Write_Line (Tok_Comma);
1893 1
            Write_Indentation;
1894 1
         end loop;
1895 1
         Write (Tok_Right_Paren);
1896 1
         Decrement_Indentation;
1897
      end if;
1898 1
   end Generate_Pragma_Statement;
1899

1900
   ------------------------------
1901
   -- Generate_Pragma_Warnings --
1902
   ------------------------------
1903

1904 1
   procedure Generate_Pragma_Warnings (W : Pragma_W) is
1905
   begin
1906 1
      Write (Tok_Pragma);
1907 1
      Write_Space;
1908 1
      Write_Name (GN (Pragma_Warnings));
1909 1
      Write_Space;
1910 1
      Write (Tok_Left_Paren);
1911

1912 1
      if W = W_On then
1913 1
         Write_Str ("On");
1914
      else
1915 1
         Write_Str ("Off");
1916
      end if;
1917

1918 1
      Write (Tok_Right_Paren);
1919 1
   end Generate_Pragma_Warnings;
1920

1921
   ------------------------------------
1922
   -- Generate_Protected_Object_Spec --
1923
   ------------------------------------
1924

1925 1
   procedure Generate_Protected_Object_Spec (N : Node_Id) is
1926 1
      P : Node_Id;
1927
   begin
1928 1
      Write (Tok_Protected);
1929 1
      Write_Space;
1930

1931 1
      if Is_Type (N) then
1932 1
         Write (Tok_Type);
1933 1
         Write_Space;
1934
      end if;
1935

1936 1
      Generate (Defining_Identifier (N));
1937 1
      Write_Space;
1938 1
      Write (Tok_Is);
1939 1
      Write_Eol;
1940

1941 1
      Increment_Indentation;
1942 1
      P := First_Node (Visible_Part (N));
1943 1
      while Present (P) loop
1944 1
         Write_Indentation;
1945 1
         Generate (P);
1946 1
         Generate_Statement_Delimiter (P);
1947 1
         P := Next_Node (P);
1948 1
      end loop;
1949 1
      Decrement_Indentation;
1950

1951 1
      if not Is_Empty (Private_Part (N)) then
1952 1
         Write_Indentation;
1953 1
         Write (Tok_Private);
1954 1
         Write_Eol;
1955 1
         Increment_Indentation;
1956 1
         P := First_Node (Private_Part (N));
1957 1
         while Present (P) loop
1958 1
            Write_Indentation;
1959 1
            Generate (P);
1960 1
            Generate_Statement_Delimiter (P);
1961 1
            P := Next_Node (P);
1962 1
         end loop;
1963 1
         Decrement_Indentation;
1964
      end if;
1965

1966 1
      Write_Indentation;
1967 1
      Write (Tok_End);
1968 1
      Write_Space;
1969 1
      Generate (Defining_Identifier (N));
1970 1
   end Generate_Protected_Object_Spec;
1971

1972
   ------------------------------------
1973
   -- Generate_Protected_Object_Body --
1974
   ------------------------------------
1975

1976 1
   procedure Generate_Protected_Object_Body (N : Node_Id) is
1977 1
      P : Node_Id;
1978
   begin
1979 1
      Write (Tok_Protected);
1980 1
      Write_Space;
1981 1
      Write (Tok_Body);
1982 1
      Write_Space;
1983 1
      Generate (Defining_Identifier (N));
1984 1
      Write_Space;
1985 1
      Write (Tok_Is);
1986 1
      Write_Eol;
1987

1988 1
      Increment_Indentation;
1989 1
      P := First_Node (Statements (N));
1990 1
      while Present (P) loop
1991 1
         Write_Indentation;
1992 1
         Generate (P);
1993 1
         Generate_Statement_Delimiter (P);
1994 1
         Write_Eol;
1995 1
         P := Next_Node (P);
1996 1
      end loop;
1997 1
      Decrement_Indentation;
1998 1
      Write_Indentation;
1999

2000 1
      Write (Tok_End);
2001 1
      Write_Space;
2002 1
      Generate (Defining_Identifier (N));
2003 1
   end Generate_Protected_Object_Body;
2004

2005
   -----------------------------------
2006
   -- Generate_Qualified_Expression --
2007
   -----------------------------------
2008

2009 1
   procedure Generate_Qualified_Expression (N : Node_Id) is
2010
   begin
2011 1
      Generate (Subtype_Mark (N));
2012 1
      Write_Line (Tok_Apostrophe);
2013 1
      Increment_Indentation;
2014 1
      Write_Indentation (-1);
2015 1
      Generate (Aggregate (N));
2016 1
      Decrement_Indentation;
2017 1
   end Generate_Qualified_Expression;
2018

2019
   -------------------------------
2020
   -- Generate_Range_Constraint --
2021
   -------------------------------
2022

2023 1
   procedure Generate_Range_Constraint (N : Node_Id) is
2024 1
      May_Be_Unconstrained : Boolean := False;
2025
   begin
2026 1
      if Present (Index_Type (N)) then
2027 1
         Generate (Index_Type (N));
2028

2029 1
         if Kind (Index_Type (N)) /= K_Attribute_Designator then
2030 1
            May_Be_Unconstrained := True;
2031

2032 1
            Write_Space;
2033 1
            Write (Tok_Range);
2034 1
            Write_Space;
2035
         end if;
2036
      end if;
2037

2038 1
      if Present (First (N)) and then Present (Last (N)) then
2039 1
         Generate (First (N));
2040 1
         Write_Space;
2041 1
         Write (Tok_Dot);
2042 1
         Write (Tok_Dot);
2043 1
         Write_Space;
2044 1
         Generate (Last (N));
2045 0
      elsif May_Be_Unconstrained then
2046 0
         Write (Tok_Box);
2047
      end if;
2048 1
   end Generate_Range_Constraint;
2049

2050
   ------------------------------
2051
   -- Generate_Raise_Statement --
2052
   ------------------------------
2053

2054 1
   procedure Generate_Raise_Statement (N : Node_Id) is
2055 1
      E : constant Node_Id := Raised_Error (N);
2056
   begin
2057 1
      Write (Tok_Raise);
2058

2059 1
      if Present (E) then
2060 1
         Write_Space;
2061 1
         Generate (E);
2062
      end if;
2063 1
   end Generate_Raise_Statement;
2064

2065
   -------------------------------
2066
   -- Generate_Record_Aggregate --
2067
   -------------------------------
2068

2069 1
   procedure Generate_Record_Aggregate (N : Node_Id) is
2070 1
      L : List_Id;
2071 1
      M : Node_Id;
2072
   begin
2073 1
      L := Component_Association_List (N);
2074 1
      Write (Tok_Left_Paren);
2075

2076 1
      if not Is_Empty (L) then
2077 1
         M := First_Node (L);
2078
         loop
2079 1
            Generate (M);
2080 1
            M := Next_Node (M);
2081 1
            exit when No (M);
2082 1
            Write_Line (Tok_Comma);
2083 1
            Write_Indentation;
2084 1
         end loop;
2085
      end if;
2086

2087 1
      Write (Tok_Right_Paren);
2088 1
   end Generate_Record_Aggregate;
2089

2090
   --------------------------------
2091
   -- Generate_Record_Definition --
2092
   --------------------------------
2093

2094 1
   procedure Generate_Record_Definition (N : Node_Id) is
2095 1
      L : constant List_Id := Component_List (N);
2096 1
      C : Node_Id;
2097

2098
   begin
2099 1
      if Is_Empty (L) then
2100 0
         Write (Tok_Null);
2101 0
         Write_Space;
2102 0
         Write (Tok_Record);
2103
      else
2104 1
         Write_Space;
2105 1
         Write (Tok_Record);
2106 1
         Write_Eol;
2107 1
         Increment_Indentation;
2108 1
         C := First_Node (L);
2109 1
         while Present (C) loop
2110 1
            Write_Indentation;
2111 1
            Generate (C);
2112 1
            Generate_Statement_Delimiter (C);
2113 1
            C := Next_Node (C);
2114 1
         end loop;
2115 1
         Decrement_Indentation;
2116 1
         Write_Indentation;
2117 1
         Write (Tok_End);
2118 1
         Write_Space;
2119 1
         Write (Tok_Record);
2120
      end if;
2121 1
   end Generate_Record_Definition;
2122

2123
   -------------------------------------
2124
   -- Generate_Record_Type_Definition --
2125
   -------------------------------------
2126

2127 1
   procedure Generate_Record_Type_Definition (N : Node_Id) is
2128 1
      R : Node_Id;
2129

2130
   begin
2131 1
      if Is_Abstract_Type (N) then
2132 0
         Write (Tok_Abstract);
2133 0
         Write_Space;
2134
      end if;
2135

2136 1
      if Is_Tagged_Type (N) then
2137 0
         Write (Tok_Tagged);
2138 0
         Write_Space;
2139
      end if;
2140

2141 1
      if Is_Limited_Type (N) then
2142 0
         Write (Tok_Limited);
2143 0
         Write_Space;
2144
      end if;
2145

2146 1
      R := Record_Definition (N);
2147

2148 1
      if Present (R) then
2149 1
         Generate (R);
2150
      end if;
2151 1
   end Generate_Record_Type_Definition;
2152

2153
   -------------------------------
2154
   -- Generate_Return_Statement --
2155
   -------------------------------
2156

2157 1
   procedure Generate_Return_Statement (N : Node_Id) is
2158 1
      E : constant Node_Id := Expression (N);
2159
   begin
2160 1
      Write (Tok_Return);
2161

2162 1
      if Present (E) then
2163 1
         Write_Space;
2164 1
         Generate (E);
2165
      end if;
2166 1
   end Generate_Return_Statement;
2167

2168
   ---------------------------------
2169
   -- Generate_Selected_Component --
2170
   ---------------------------------
2171

2172 1
   procedure Generate_Selected_Component (N : Node_Id) is
2173
   begin
2174 1
      Generate (Prefix (N));
2175 1
      Write (Tok_Dot);
2176 1
      Generate (Selector_Name (N));
2177 1
   end Generate_Selected_Component;
2178

2179
   ------------------------------
2180
   -- Generate_Subprogram_Call --
2181
   ------------------------------
2182

2183 1
   procedure Generate_Subprogram_Call (N : Node_Id) is
2184 1
      L : constant List_Id := Actual_Parameter_Part (N);
2185 1
      P : Node_Id;
2186

2187
   begin
2188 1
      Generate (Defining_Identifier (N));
2189

2190 1
      if not Is_Empty (L) then
2191 1
         Write_Eol;
2192 1
         Increment_Indentation;
2193 1
         Write_Indentation (-1);
2194 1
         Write (Tok_Left_Paren);
2195 1
         P := First_Node (L);
2196
         loop
2197 1
            Generate (P);
2198 1
            P := Next_Node (P);
2199 1
            exit when No (P);
2200 1
            Write_Line (Tok_Comma);
2201 1
            Write_Indentation;
2202 1
         end loop;
2203 1
         Write (Tok_Right_Paren);
2204 1
         Decrement_Indentation;
2205
      end if;
2206 1
   end Generate_Subprogram_Call;
2207

2208
   ----------------------------------------
2209
   -- Generate_Subprogram_Implementation --
2210
   ----------------------------------------
2211

2212 1
   procedure Generate_Subprogram_Implementation (N : Node_Id) is
2213 1
      D : constant List_Id := Declarations (N);
2214 1
      S : constant List_Id := Statements (N);
2215 1
      P : constant Node_Id := Specification (N);
2216 1
      M : Node_Id;
2217 1
      W : Node_Id;
2218
   begin
2219

2220
      --  If we deal with a main subprogram, then we generate its
2221
      --  headers
2222

2223 1
      if not Is_Empty (Package_Headers (N)) then
2224 1
         W := First_Node (Package_Headers (N));
2225 1
         while Present (W) loop
2226 1
            Generate (W);
2227 1
            Generate_Statement_Delimiter (W);
2228 1
            Write_Indentation;
2229 1
            W := Next_Node (W);
2230 1
         end loop;
2231 1
         Write_Eol;
2232 1
         Write_Indentation;
2233
      end if;
2234

2235
      --  If we deal with a main subprogram, then we generate its
2236
      --  withed packages
2237

2238 1
      if not Is_Empty (Withed_Packages (N)) then
2239 1
         W := First_Node (Withed_Packages (N));
2240 1
         while Present (W) loop
2241 1
            Generate (W);
2242 1
            Generate_Statement_Delimiter (W);
2243 1
            Write_Indentation;
2244 1
            W := Next_Node (W);
2245 1
         end loop;
2246 1
         Write_Eol;
2247 1
         Write_Indentation;
2248
      end if;
2249

2250 1
      Generate_Comment_Box (Name (Defining_Identifier (P)));
2251 1
      Write_Eol;
2252

2253 1
      Write_Indentation;
2254 1
      Generate (P);
2255

2256 1
      if not Is_Empty (Parameter_Profile (P)) then
2257 1
         Write_Eol;
2258 1
         Write_Indentation;
2259
      else
2260 1
         Write_Space;
2261
      end if;
2262

2263 1
      Write (Tok_Is);
2264 1
      Write_Eol;
2265

2266 1
      if not Is_Empty (D) then
2267 1
         Increment_Indentation;
2268 1
         M := First_Node (D);
2269 1
         while Present (M) loop
2270 1
            Write_Indentation;
2271 1
            Generate (M);
2272 1
            Generate_Statement_Delimiter (M);
2273 1
            M := Next_Node (M);
2274 1
         end loop;
2275 1
         Decrement_Indentation;
2276
      end if;
2277

2278 1
      Write_Indentation;
2279 1
      Write (Tok_Begin);
2280 1
      Write_Eol;
2281 1
      Increment_Indentation;
2282

2283 1
      if not Is_Empty (S) then
2284 1
         M := First_Node (S);
2285 1
         while Present (M) loop
2286 1
            Write_Indentation;
2287 1
            Generate (M);
2288 1
            Generate_Statement_Delimiter (M);
2289 1
            M := Next_Node (M);
2290 1
         end loop;
2291
      else
2292 1
         Write_Indentation;
2293 1
         Write (Tok_Null);
2294 1
         Write_Line (Tok_Semicolon);
2295
      end if;
2296

2297 1
      Decrement_Indentation;
2298 1
      Write_Indentation;
2299 1
      Write (Tok_End);
2300 1
      Write_Space;
2301 1
      Write_Name (Name (Defining_Identifier (P)));
2302 1
   end Generate_Subprogram_Implementation;
2303

2304
   ---------------------------------------
2305
   -- Generate_Subprogram_Specification --
2306
   ---------------------------------------
2307

2308 1
   procedure Generate_Subprogram_Specification (N : Node_Id) is
2309 1
      P : constant List_Id := Parameter_Profile (N);
2310 1
      T : constant Node_Id := Return_Type (N);
2311 1
      R : constant Node_Id := Renamed_Entity (N);
2312 1
      G : constant Node_Id := Instantiated_Entity (N);
2313 1
      W : Node_Id;
2314
   begin
2315
      --  If we deal with a main subprogram, then we generate its
2316
      --  headers
2317

2318 1
      if not Is_Empty (Package_Headers (N)) then
2319 0
         W := First_Node (Package_Headers (N));
2320 0
         while Present (W) loop
2321 0
            Generate (W);
2322 0
            Generate_Statement_Delimiter (W);
2323 0
            Write_Indentation;
2324 0
            W := Next_Node (W);
2325 0
         end loop;
2326 0
         Write_Eol;
2327 0
         Write_Indentation;
2328
      end if;
2329

2330
      --  If we deal with a main subprogram, then we generate its
2331
      --  withed packages
2332

2333 1
      if not Is_Empty (Withed_Packages (N)) then
2334 0
         W := First_Node (Withed_Packages (N));
2335 0
         while Present (W) loop
2336 0
            Generate (W);
2337 0
            Generate_Statement_Delimiter (W);
2338 0
            Write_Indentation;
2339 0
            W := Next_Node (W);
2340 0
         end loop;
2341 0
         Write_Eol;
2342 0
         Write_Indentation;
2343
      end if;
2344

2345 1
      if Present (T) then
2346 1
         Write (Tok_Function);
2347
      else
2348 1
         Write (Tok_Procedure);
2349
      end if;
2350

2351
      --  This work around is used to define access subprogram types
2352

2353 1
      if Present (Defining_Identifier (N)) then
2354 1
         Write_Space;
2355 1
         Write_Name (Name (Defining_Identifier (N)));
2356
      end if;
2357

2358 1
      if not Is_Empty (P) then
2359 1
         Write_Eol;
2360 1
         Generate_Parameter_List (P);
2361
      end if;
2362

2363 1
      if Present (T) then
2364 1
         if not Is_Empty (P) then
2365 1
            Write_Eol;
2366 1
            Increment_Indentation;
2367 1
            Write_Indentation (-1);
2368
         else
2369 0
            Write_Space;
2370
         end if;
2371

2372 1
         Write (Tok_Return);
2373 1
         Write_Space;
2374 1
         Generate (T);
2375

2376 1
         if not Is_Empty (P) then
2377 1
            Decrement_Indentation;
2378
         end if;
2379
      end if;
2380

2381 1
      if Present (R) then
2382 1
         Write_Eol;
2383 1
         Increment_Indentation;
2384 1
         Write_Indentation (-1);
2385 1
         Write (Tok_Renames);
2386 1
         Write_Space;
2387 1
         Generate (R);
2388 1
         Decrement_Indentation;
2389
      end if;
2390

2391 1
      if Present (G) then
2392 0
         Write_Space;
2393 0
         Write (Tok_Is);
2394 0
         Write_Eol;
2395 0
         Increment_Indentation;
2396 0
         Write_Indentation (-1);
2397 0
         Write (Tok_New);
2398 0
         Write_Space;
2399 0
         Generate (G);
2400 0
         Decrement_Indentation;
2401
      end if;
2402

2403 1
      Generate_Aspect (Aspect_Specification (N));
2404 1
   end Generate_Subprogram_Specification;
2405

2406
   ---------------------
2407
   -- Generate_Aspect --
2408
   ---------------------
2409

2410 1
   procedure Generate_Aspect (N : Node_Id) is
2411 1
      W : Node_Id;
2412
   begin
2413 1
      if Present (N) and then
2414 0
        not Is_Empty (Aspect (N))
2415
      then
2416 0
         Write_Eol;
2417 0
         Increment_Indentation;
2418 0
         Write_Indentation;
2419 0
         Write (Tok_With);
2420 0
         Write_Space;
2421

2422 0
         W := First_Node (Aspect (N));
2423 0
         while Present (W) loop
2424 0
            Write_Name (Aspect_Mark (W));
2425 0
            if Present (Aspect_Definition (W)) then
2426 0
               if Kind (Aspect_Definition (W)) = K_Pre_Definition then
2427 0
                  Write_Space;
2428 0
                  Write (Tok_Arrow);
2429 0
                  Write_Space;
2430 0
                  Write (Tok_Left_Paren);
2431 0
                  Generate (Subprogram_Call (Aspect_Definition (W)));
2432 0
                  Write (Tok_Right_Paren);
2433

2434 0
               elsif Kind (Aspect_Definition (W)) = K_Global_Specification then
2435
                  declare
2436 0
                     X : Node_Id;
2437
                  begin
2438 0
                     X := First_Node (Moded_Global_List
2439 0
                                        (Aspect_Definition (W)));
2440 0
                     while (Present (X)) loop
2441 0
                        Write_Space;
2442 0
                        Write (Tok_Arrow);
2443 0
                        Write_Space;
2444 0
                        Write (Tok_Left_Paren);
2445 0
                        if Mode_Selector (X) = Mode_In then
2446 0
                           Write_Str ("Input => ");
2447
                        else
2448 0
                           raise Program_Error;
2449
                        end if;
2450 0
                        Write (Tok_Left_Paren);
2451 0
                        Generate (Defining_Identifier (X));
2452 0
                        Write (Tok_Right_Paren);
2453 0
                        Write (Tok_Right_Paren);
2454 0
                        X := Next_Node (X);
2455 0
                     end loop;
2456
                  end;
2457

2458 0
               elsif Kind (Aspect_Definition (W)) = K_Initialization_Spec then
2459
                  declare
2460 0
                     X : Node_Id;
2461
                  begin
2462 0
                     X := First_Node (Initialization_List
2463 0
                                        (Aspect_Definition (W)));
2464 0
                     while (Present (X)) loop
2465 0
                        Write_Space;
2466 0
                        Write (Tok_Arrow);
2467 0
                        Write_Space;
2468 0
                        Write (Tok_Left_Paren);
2469 0
                        Generate (X);
2470 0
                        Write (Tok_Right_Paren);
2471 0
                        X := Next_Node (X);
2472 0
                        exit when No (W);
2473 0
                     end loop;
2474
                  end;
2475

2476 0
               elsif Kind (Aspect_Definition (W)) = K_Abstract_State_List then
2477
                  declare
2478 0
                     X : Node_Id;
2479
                  begin
2480 0
                     X := First_Node (State_Name_With_Option
2481 0
                                        (Aspect_Definition (W)));
2482 0
                     while (Present (X)) loop
2483 0
                        Write_Space;
2484 0
                        Write (Tok_Arrow);
2485 0
                        Write_Space;
2486 0
                        Write (Tok_Left_Paren);
2487 0
                        Generate (Defining_Identifier (X));
2488

2489 0
                        if Synchronous (X) or else External (X) then
2490 0
                           Write_Space;
2491 0
                           Write (Tok_With);
2492 0
                           Write_Space;
2493

2494 0
                           if Synchronous (X) then
2495 0
                              Write_Str ("Synchronous");
2496
                           end if;
2497 0
                           if Synchronous (X) and then External (X) then
2498 0
                              Write_Str (", ");
2499
                           end if;
2500 0
                           if External (X) then
2501 0
                              Write_Str ("External");
2502
                           end if;
2503
                        end if;
2504

2505 0
                        Write (Tok_Right_Paren);
2506 0
                        X := Next_Node (X);
2507 0
                        exit when No (W);
2508 0
                     end loop;
2509
                  end;
2510

2511 0
               elsif Kind (Aspect_Definition (W)) = K_Refinement_List then
2512
                  declare
2513 0
                     X : Node_Id;
2514
                  begin
2515 0
                     X := First_Node (Refinement_Clause
2516 0
                                        (Aspect_Definition (W)));
2517 0
                     while (Present (X)) loop
2518 0
                        Write_Space;
2519 0
                        Write (Tok_Arrow);
2520 0
                        Write_Space;
2521 0
                        Write (Tok_Left_Paren);
2522 0
                        Generate (State_Name (X));
2523

2524
                        declare
2525 0
                           Y : Node_Id;
2526
                        begin
2527 0
                           Y := First_Node (Constituent (X));
2528 0
                           if Present (Y) then
2529 0
                              Write_Space;
2530 0
                              Write (Tok_Arrow);
2531 0
                              Write_Eol;
2532 0
                              Write_Indentation (9);
2533 0
                              Write (Tok_Left_Paren);
2534
                           end if;
2535

2536 0
                           while (Present (Y)) loop
2537 0
                              Generate (Y);
2538 0
                              Y := Next_Node (Y);
2539 0
                              exit when No (Y);
2540 0
                              Write (Tok_Comma);
2541 0
                              Write_Eol;
2542 0
                              Write_Indentation (10);
2543 0
                           end loop;
2544
                        end;
2545

2546 0
                        Write (Tok_Right_Paren);
2547 0
                        X := Next_Node (X);
2548 0
                        exit when No (W);
2549 0
                     end loop;
2550 0
                     Write (Tok_Right_Paren);
2551
                  end;
2552

2553
               end if;
2554
            end if;
2555 0
            W := Next_Node (W);
2556

2557 0
            exit when No (W);
2558 0
            Write (Tok_Comma);
2559 0
            Write_Eol;
2560 0
            Write_Indentation (5);
2561 0
         end loop;
2562 0
         Decrement_Indentation;
2563 0
         Write_Space;
2564
      end if;
2565 1
   end Generate_Aspect;
2566

2567
   ------------------------------
2568
   -- Generate_Type_Conversion --
2569
   ------------------------------
2570

2571 0
   procedure Generate_Type_Conversion (N : Node_Id) is
2572
   begin
2573 0
      Generate (Subtype_Mark (N));
2574 0
      Write_Eol;
2575 0
      Increment_Indentation;
2576 0
      Write_Indentation (-1);
2577 0
      Write (Tok_Left_Paren);
2578 0
      Generate (Expression (N));
2579 0
      Write (Tok_Right_Paren);
2580 0
      Decrement_Indentation;
2581 0
   end Generate_Type_Conversion;
2582

2583
   ------------------------
2584
   -- Generate_Used_Type --
2585
   ------------------------
2586

2587 1
   procedure Generate_Used_Type (N : Node_Id) is
2588
   begin
2589 1
      Write (Tok_Use);
2590 1
      Write_Space;
2591 1
      Write (Tok_Type);
2592 1
      Write_Space;
2593 1
      Generate (The_Used_Entity (N));
2594 1
   end Generate_Used_Type;
2595

2596
   ---------------------------
2597
   -- Generate_Used_Package --
2598
   ---------------------------
2599

2600 1
   procedure Generate_Used_Package (N : Node_Id) is
2601
   begin
2602 1
      Write (Tok_Use);
2603 1
      Write_Space;
2604 1
      Generate (The_Used_Entity (N));
2605 1
   end Generate_Used_Package;
2606

2607
   ---------------------------
2608
   -- Generate_Variant_Part --
2609
   ---------------------------
2610

2611 1
   procedure Generate_Variant_Part (N : Node_Id) is
2612 1
      V : Node_Id;
2613 1
      C : Node_Id;
2614 1
      O : Node_Id := No_Node;
2615 1
      R : Node_Id;
2616

2617
   begin
2618 1
      Write (Tok_Case);
2619 1
      Write_Space;
2620 1
      Generate (Discriminant (N));
2621 1
      Write_Space;
2622 1
      Write (Tok_Is);
2623 1
      Write_Eol;
2624 1
      V := First_Node (Variants (N));
2625 1
      Increment_Indentation;
2626 1
      while Present (V) loop
2627 1
         C := First_Node (Discrete_Choices (V));
2628

2629 1
         if No (C)
2630 1
           or else (Kind (C) = K_Literal and then Value (C) = No_Value)
2631
         then
2632 0
            O := V;
2633
         else
2634 1
            Write_Indentation;
2635 1
            Write (Tok_When);
2636 1
            Write_Space;
2637 1
            Increment_Indentation;
2638
            loop
2639 1
               Generate (C);
2640 1
               C := Next_Node (C);
2641

2642 1
               if No (C) then
2643 1
                  Write_Space;
2644 1
                  Write (Tok_Arrow);
2645 1
                  Write_Eol;
2646 1
                  exit;
2647
               end if;
2648

2649 0
               Write_Eol;
2650 0
               Write_Indentation (-1);
2651 0
               Write (Tok_Vertical_Bar);
2652 0
               Write_Space;
2653 0
            end loop;
2654 1
            Write_Indentation;
2655

2656 1
            if not Is_Empty (Component_List (V)) then
2657 1
               R := First_Node (Component_List (V));
2658

2659 1
               while Present (R) loop
2660 1
                  Generate (R);
2661 1
                  Generate_Statement_Delimiter (R);
2662 1
                  R := Next_Node (R);
2663 1
                  exit when No (R);
2664 0
                  Write_Indentation;
2665 0
               end loop;
2666
            else
2667 1
               Write (Tok_Null);
2668 1
               Write_Line (Tok_Semicolon);
2669
            end if;
2670

2671 1
            Decrement_Indentation;
2672
         end if;
2673

2674 1
         V := Next_Node (V);
2675 1
      end loop;
2676

2677
      --  Add a "when others" clause either based on the "default"
2678
      --  label or a null one. In case of null statement, add two
2679
      --  pragmas to disable warnings and enable them after the
2680
      --  addition of the null statement
2681

2682 1
      if No (O) then
2683 1
         Write_Indentation;
2684 1
         Generate_Pragma_Warnings (W_Off);
2685 1
         Write_Line (Tok_Semicolon);
2686
      end if;
2687

2688 1
      Write_Indentation;
2689 1
      Write (Tok_When);
2690 1
      Write_Space;
2691 1
      Write (Tok_Others);
2692 1
      Write_Space;
2693 1
      Write (Tok_Arrow);
2694 1
      Write_Eol;
2695 1
      Increment_Indentation;
2696 1
      Write_Indentation;
2697

2698 1
      if Present (O) then
2699 0
         if not Is_Empty (Component_List (O)) then
2700 0
            R := First_Node (Component_List (O));
2701

2702 0
            while Present (R) loop
2703 0
               Generate (R);
2704 0
               Generate_Statement_Delimiter (R);
2705 0
               R := Next_Node (R);
2706 0
            end loop;
2707
         else
2708 0
            Write (Tok_Null);
2709 0
            Write_Line (Tok_Semicolon);
2710
         end if;
2711
      else
2712 1
         Write (Tok_Null);
2713 1
         Generate_Statement_Delimiter (O);
2714
      end if;
2715

2716 1
      Decrement_Indentation;
2717

2718 1
      if No (O) then
2719 1
         Write_Indentation;
2720 1
         Generate_Pragma_Warnings (W_On);
2721 1
         Write_Line (Tok_Semicolon);
2722
      end if;
2723

2724 1
      Decrement_Indentation;
2725 1
      Write_Indentation;
2726 1
      Write (Tok_End);
2727 1
      Write_Space;
2728 1
      Write (Tok_Case);
2729 1
   end Generate_Variant_Part;
2730

2731
   -----------------------------------------
2732
   -- Generate_HI_Distributed_Application --
2733
   -----------------------------------------
2734

2735 1
   procedure Generate_HI_Distributed_Application (N : Node_Id) is
2736 1
      P                     : Node_Id := First_Node (HI_Nodes (N));
2737 1
      Application_Directory : Name_Id;
2738
   begin
2739
      --  Create the application directory (a lower case string)
2740

2741 1
      Get_Name_String (Name (N));
2742 1
      Application_Directory := To_Lower (Name_Find);
2743

2744 1
      Create_Directory (Application_Directory);
2745

2746
      --  Process the application nodes
2747

2748 1
      Enter_Directory (Application_Directory);
2749

2750 1
      while Present (P) loop
2751 1
         Generate (P);
2752 1
         P := Next_Node (P);
2753 1
      end loop;
2754

2755 1
      Leave_Directory;
2756 1
   end Generate_HI_Distributed_Application;
2757

2758
   ----------------------
2759
   -- Generate_HI_Node --
2760
   ----------------------
2761

2762 1
   procedure Generate_HI_Node (N : Node_Id) is
2763 1
      U                   : Node_Id          := First_Node (Units (N));
2764 1
      Partition_Directory : constant Name_Id := To_Lower (Name (N));
2765
   begin
2766
      --  Create the node directory
2767

2768 1
      Create_Directory (Partition_Directory);
2769 1
      Enter_Directory (Partition_Directory);
2770

2771 1
      while Present (U) loop
2772 1
         Generate (U);
2773 1
         U := Next_Node (U);
2774 1
      end loop;
2775

2776 1
      Leave_Directory;
2777 1
   end Generate_HI_Node;
2778

2779
   -----------------------------
2780
   -- Generate_Withed_Package --
2781
   -----------------------------
2782

2783 1
   procedure Generate_Withed_Package (N : Node_Id) is
2784
   begin
2785 1
      Write (Tok_With);
2786 1
      Write_Space;
2787 1
      Generate (Defining_Identifier (N));
2788

2789 1
      if Used (N) then
2790 1
         Write (Tok_Semicolon);
2791 1
         Write_Eol;
2792 1
         Write_Indentation;
2793 1
         Write (Tok_Use);
2794 1
         Write_Space;
2795 1
         Generate (Defining_Identifier (N));
2796
      end if;
2797

2798 1
      if Warnings_Off (N) then
2799 1
         Write (Tok_Semicolon);
2800 1
         Write_Eol;
2801 1
         Write_Indentation;
2802 1
         Write (Tok_Pragma);
2803 1
         Write_Space;
2804 1
         Write_Str ("Warnings");
2805 1
         Write_Space;
2806 1
         Write (Tok_Left_Paren);
2807 1
         Write_Str ("Off");
2808 1
         Write (Tok_Comma);
2809 1
         Write_Space;
2810 1
         Generate (Defining_Identifier (N));
2811 1
         Write (Tok_Right_Paren);
2812
      end if;
2813

2814 1
      if Elaborated (N) then
2815 1
         Write (Tok_Semicolon);
2816 1
         Write_Eol;
2817 1
         Write_Indentation;
2818 1
         Write (Tok_Pragma);
2819 1
         Write_Space;
2820 1
         Write_Str ("Elaborate_All");
2821 1
         Write_Space;
2822 1
         Write (Tok_Left_Paren);
2823 1
         Generate (Defining_Identifier (N));
2824 1
         Write (Tok_Right_Paren);
2825
      end if;
2826

2827 1
   end Generate_Withed_Package;
2828

2829
   -----------
2830
   -- Write --
2831
   -----------
2832

2833 1
   procedure Write (T : Token_Type) is
2834
   begin
2835 1
      Write_Name (Token_Image (T));
2836 1
   end Write;
2837

2838
   ----------------
2839
   -- Write_Line --
2840
   ----------------
2841

2842 1
   procedure Write_Line (T : Token_Type) is
2843
   begin
2844 1
      Write (T);
2845 1
      Write_Eol;
2846 1
   end Write_Line;
2847

2848
   ----------------------------------
2849
   -- Generate_Statement_Delimiter --
2850
   ----------------------------------
2851

2852 1
   procedure Generate_Statement_Delimiter (N : Node_Id) is
2853
   begin
2854 1
      if No (N) or else Kind (N) /= K_Ada_Comment then
2855 1
         Write_Line (Tok_Semicolon);
2856
      else
2857 1
         Write_Eol;
2858
      end if;
2859 1
   end Generate_Statement_Delimiter;
2860

2861
   --------------------------
2862
   -- Generate_Comment_Box --
2863
   --------------------------
2864

2865 1
   procedure Generate_Comment_Box (M : Name_Id) is
2866
   begin
2867 1
      Get_Name_String (M);
2868

2869 1
      for I in 1 .. Name_Len + 6 loop
2870 1
         Write_Char ('-');
2871 1
      end loop;
2872 1
      Write_Eol;
2873 1
      Write_Indentation;
2874

2875 1
      Write_Str ("-- ");
2876 1
      Write_Name (M);
2877 1
      Write_Str (" -- ");
2878 1
      Write_Eol;
2879 1
      Write_Indentation;
2880

2881 1
      for I in 1 .. Name_Len + 6 loop
2882 1
         Write_Char ('-');
2883 1
      end loop;
2884 1
      Write_Eol;
2885 1
   end Generate_Comment_Box;
2886

2887
end Ocarina.Backends.Ada_Tree.Generator;

Read our documentation on viewing source code .

Loading