OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [prj-tree.adb] - Blame information for rev 750

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT COMPILER COMPONENTS                         --
4
--                                                                          --
5
--                              P R J . T R E E                             --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2001-2011, Free Software Foundation, Inc.         --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
17
-- for  more details.  You should have  received  a copy of the GNU General --
18
-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
19
-- http://www.gnu.org/licenses for a complete copy of the license.          --
20
--                                                                          --
21
-- GNAT was originally developed  by the GNAT team at  New York University. --
22
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23
--                                                                          --
24
------------------------------------------------------------------------------
25
 
26
with Osint;   use Osint;
27
with Prj.Env; use Prj.Env;
28
with Prj.Err;
29
 
30
with Ada.Unchecked_Deallocation;
31
 
32
package body Prj.Tree is
33
 
34
   Node_With_Comments : constant array (Project_Node_Kind) of Boolean :=
35
     (N_Project                    => True,
36
      N_With_Clause                => True,
37
      N_Project_Declaration        => False,
38
      N_Declarative_Item           => False,
39
      N_Package_Declaration        => True,
40
      N_String_Type_Declaration    => True,
41
      N_Literal_String             => False,
42
      N_Attribute_Declaration      => True,
43
      N_Typed_Variable_Declaration => True,
44
      N_Variable_Declaration       => True,
45
      N_Expression                 => False,
46
      N_Term                       => False,
47
      N_Literal_String_List        => False,
48
      N_Variable_Reference         => False,
49
      N_External_Value             => False,
50
      N_Attribute_Reference        => False,
51
      N_Case_Construction          => True,
52
      N_Case_Item                  => True,
53
      N_Comment_Zones              => True,
54
      N_Comment                    => True);
55
   --  Indicates the kinds of node that may have associated comments
56
 
57
   package Next_End_Nodes is new Table.Table
58
     (Table_Component_Type => Project_Node_Id,
59
      Table_Index_Type     => Natural,
60
      Table_Low_Bound      => 1,
61
      Table_Initial        => 10,
62
      Table_Increment      => 100,
63
      Table_Name           => "Next_End_Nodes");
64
   --  A stack of nodes to indicates to what node the next "end" is associated
65
 
66
   use Tree_Private_Part;
67
 
68
   End_Of_Line_Node   : Project_Node_Id := Empty_Node;
69
   --  The node an end of line comment may be associated with
70
 
71
   Previous_Line_Node : Project_Node_Id := Empty_Node;
72
   --  The node an immediately following comment may be associated with
73
 
74
   Previous_End_Node  : Project_Node_Id := Empty_Node;
75
   --  The node comments immediately following an "end" line may be
76
   --  associated with.
77
 
78
   Unkept_Comments    : Boolean := False;
79
   --  Set to True when some comments may not be associated with any node
80
 
81
   function Comment_Zones_Of
82
     (Node    : Project_Node_Id;
83
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id;
84
   --  Returns the ID of the N_Comment_Zones node associated with node Node.
85
   --  If there is not already an N_Comment_Zones node, create one and
86
   --  associate it with node Node.
87
 
88
   ------------------
89
   -- Add_Comments --
90
   ------------------
91
 
92
   procedure Add_Comments
93
     (To       : Project_Node_Id;
94
      In_Tree  : Project_Node_Tree_Ref;
95
      Where    : Comment_Location) is
96
      Zone     : Project_Node_Id := Empty_Node;
97
      Previous : Project_Node_Id := Empty_Node;
98
 
99
   begin
100
      pragma Assert
101
        (Present (To)
102
          and then In_Tree.Project_Nodes.Table (To).Kind /= N_Comment);
103
 
104
      Zone := In_Tree.Project_Nodes.Table (To).Comments;
105
 
106
      if No (Zone) then
107
 
108
         --  Create new N_Comment_Zones node
109
 
110
         Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
111
         In_Tree.Project_Nodes.Table
112
           (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
113
           (Kind      => N_Comment_Zones,
114
            Qualifier => Unspecified,
115
            Expr_Kind => Undefined,
116
            Location  => No_Location,
117
            Directory => No_Path,
118
            Variables => Empty_Node,
119
            Packages  => Empty_Node,
120
            Pkg_Id    => Empty_Package,
121
            Name      => No_Name,
122
            Src_Index => 0,
123
            Path_Name => No_Path,
124
            Value     => No_Name,
125
            Field1    => Empty_Node,
126
            Field2    => Empty_Node,
127
            Field3    => Empty_Node,
128
            Field4    => Empty_Node,
129
            Flag1     => False,
130
            Flag2     => False,
131
            Comments  => Empty_Node);
132
 
133
         Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
134
         In_Tree.Project_Nodes.Table (To).Comments := Zone;
135
      end if;
136
 
137
      if Where = End_Of_Line then
138
         In_Tree.Project_Nodes.Table (Zone).Value := Comments.Table (1).Value;
139
 
140
      else
141
         --  Get each comments in the Comments table and link them to node To
142
 
143
         for J in 1 .. Comments.Last loop
144
 
145
            --  Create new N_Comment node
146
 
147
            if (Where = After or else Where = After_End)
148
              and then Token /= Tok_EOF
149
              and then Comments.Table (J).Follows_Empty_Line
150
            then
151
               Comments.Table (1 .. Comments.Last - J + 1) :=
152
                 Comments.Table (J .. Comments.Last);
153
               Comments.Set_Last (Comments.Last - J + 1);
154
               return;
155
            end if;
156
 
157
            Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
158
            In_Tree.Project_Nodes.Table
159
              (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
160
              (Kind             => N_Comment,
161
               Qualifier        => Unspecified,
162
               Expr_Kind        => Undefined,
163
               Flag1            => Comments.Table (J).Follows_Empty_Line,
164
               Flag2            =>
165
                 Comments.Table (J).Is_Followed_By_Empty_Line,
166
               Location         => No_Location,
167
               Directory        => No_Path,
168
               Variables        => Empty_Node,
169
               Packages         => Empty_Node,
170
               Pkg_Id           => Empty_Package,
171
               Name             => No_Name,
172
               Src_Index        => 0,
173
               Path_Name        => No_Path,
174
               Value            => Comments.Table (J).Value,
175
               Field1           => Empty_Node,
176
               Field2           => Empty_Node,
177
               Field3           => Empty_Node,
178
               Field4           => Empty_Node,
179
               Comments         => Empty_Node);
180
 
181
            --  If this is the first comment, put it in the right field of
182
            --  the node Zone.
183
 
184
            if No (Previous) then
185
               case Where is
186
                  when Before =>
187
                     In_Tree.Project_Nodes.Table (Zone).Field1 :=
188
                       Project_Node_Table.Last (In_Tree.Project_Nodes);
189
 
190
                  when After =>
191
                     In_Tree.Project_Nodes.Table (Zone).Field2 :=
192
                       Project_Node_Table.Last (In_Tree.Project_Nodes);
193
 
194
                  when Before_End =>
195
                     In_Tree.Project_Nodes.Table (Zone).Field3 :=
196
                       Project_Node_Table.Last (In_Tree.Project_Nodes);
197
 
198
                  when After_End =>
199
                     In_Tree.Project_Nodes.Table (Zone).Comments :=
200
                       Project_Node_Table.Last (In_Tree.Project_Nodes);
201
 
202
                  when End_Of_Line =>
203
                     null;
204
               end case;
205
 
206
            else
207
               --  When it is not the first, link it to the previous one
208
 
209
               In_Tree.Project_Nodes.Table (Previous).Comments :=
210
                 Project_Node_Table.Last (In_Tree.Project_Nodes);
211
            end if;
212
 
213
            --  This node becomes the previous one for the next comment, if
214
            --  there is one.
215
 
216
            Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
217
         end loop;
218
      end if;
219
 
220
      --  Empty the Comments table, so that there is no risk to link the same
221
      --  comments to another node.
222
 
223
      Comments.Set_Last (0);
224
   end Add_Comments;
225
 
226
   --------------------------------
227
   -- Associative_Array_Index_Of --
228
   --------------------------------
229
 
230
   function Associative_Array_Index_Of
231
     (Node    : Project_Node_Id;
232
      In_Tree : Project_Node_Tree_Ref) return Name_Id
233
   is
234
   begin
235
      pragma Assert
236
        (Present (Node)
237
          and then
238
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
239
               or else
240
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
241
      return In_Tree.Project_Nodes.Table (Node).Value;
242
   end Associative_Array_Index_Of;
243
 
244
   ----------------------------
245
   -- Associative_Package_Of --
246
   ----------------------------
247
 
248
   function Associative_Package_Of
249
     (Node    : Project_Node_Id;
250
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
251
   is
252
   begin
253
      pragma Assert
254
        (Present (Node)
255
          and then
256
          (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
257
      return In_Tree.Project_Nodes.Table (Node).Field3;
258
   end Associative_Package_Of;
259
 
260
   ----------------------------
261
   -- Associative_Project_Of --
262
   ----------------------------
263
 
264
   function Associative_Project_Of
265
     (Node    : Project_Node_Id;
266
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
267
   is
268
   begin
269
      pragma Assert
270
        (Present (Node)
271
          and then
272
          (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration));
273
      return In_Tree.Project_Nodes.Table (Node).Field2;
274
   end Associative_Project_Of;
275
 
276
   ----------------------
277
   -- Case_Insensitive --
278
   ----------------------
279
 
280
   function Case_Insensitive
281
     (Node    : Project_Node_Id;
282
      In_Tree : Project_Node_Tree_Ref) return Boolean is
283
   begin
284
      pragma Assert
285
        (Present (Node)
286
          and then
287
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
288
               or else
289
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
290
      return In_Tree.Project_Nodes.Table (Node).Flag1;
291
   end Case_Insensitive;
292
 
293
   --------------------------------
294
   -- Case_Variable_Reference_Of --
295
   --------------------------------
296
 
297
   function Case_Variable_Reference_Of
298
     (Node    : Project_Node_Id;
299
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
300
   is
301
   begin
302
      pragma Assert
303
        (Present (Node)
304
          and then
305
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
306
      return In_Tree.Project_Nodes.Table (Node).Field1;
307
   end Case_Variable_Reference_Of;
308
 
309
   ----------------------
310
   -- Comment_Zones_Of --
311
   ----------------------
312
 
313
   function Comment_Zones_Of
314
     (Node    : Project_Node_Id;
315
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
316
   is
317
      Zone : Project_Node_Id;
318
 
319
   begin
320
      pragma Assert (Present (Node));
321
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
322
 
323
      --  If there is not already an N_Comment_Zones associated, create a new
324
      --  one and associate it with node Node.
325
 
326
      if No (Zone) then
327
         Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
328
         Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
329
         In_Tree.Project_Nodes.Table (Zone) :=
330
        (Kind             => N_Comment_Zones,
331
         Qualifier        => Unspecified,
332
         Location         => No_Location,
333
         Directory        => No_Path,
334
         Expr_Kind        => Undefined,
335
         Variables        => Empty_Node,
336
         Packages         => Empty_Node,
337
         Pkg_Id           => Empty_Package,
338
         Name             => No_Name,
339
         Src_Index        => 0,
340
         Path_Name        => No_Path,
341
         Value            => No_Name,
342
         Field1           => Empty_Node,
343
         Field2           => Empty_Node,
344
         Field3           => Empty_Node,
345
         Field4           => Empty_Node,
346
         Flag1            => False,
347
         Flag2            => False,
348
         Comments         => Empty_Node);
349
         In_Tree.Project_Nodes.Table (Node).Comments := Zone;
350
      end if;
351
 
352
      return Zone;
353
   end Comment_Zones_Of;
354
 
355
   -----------------------
356
   -- Current_Item_Node --
357
   -----------------------
358
 
359
   function Current_Item_Node
360
     (Node    : Project_Node_Id;
361
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
362
   is
363
   begin
364
      pragma Assert
365
        (Present (Node)
366
          and then
367
            In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
368
      return In_Tree.Project_Nodes.Table (Node).Field1;
369
   end Current_Item_Node;
370
 
371
   ------------------
372
   -- Current_Term --
373
   ------------------
374
 
375
   function Current_Term
376
     (Node    : Project_Node_Id;
377
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
378
   is
379
   begin
380
      pragma Assert
381
        (Present (Node)
382
          and then
383
            In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
384
      return In_Tree.Project_Nodes.Table (Node).Field1;
385
   end Current_Term;
386
 
387
   --------------------------
388
   -- Default_Project_Node --
389
   --------------------------
390
 
391
   function Default_Project_Node
392
     (In_Tree       : Project_Node_Tree_Ref;
393
      Of_Kind       : Project_Node_Kind;
394
      And_Expr_Kind : Variable_Kind := Undefined) return Project_Node_Id
395
   is
396
      Result   : Project_Node_Id;
397
      Zone     : Project_Node_Id;
398
      Previous : Project_Node_Id;
399
 
400
   begin
401
      --  Create new node with specified kind and expression kind
402
 
403
      Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
404
      In_Tree.Project_Nodes.Table
405
        (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
406
        (Kind             => Of_Kind,
407
         Qualifier        => Unspecified,
408
         Location         => No_Location,
409
         Directory        => No_Path,
410
         Expr_Kind        => And_Expr_Kind,
411
         Variables        => Empty_Node,
412
         Packages         => Empty_Node,
413
         Pkg_Id           => Empty_Package,
414
         Name             => No_Name,
415
         Src_Index        => 0,
416
         Path_Name        => No_Path,
417
         Value            => No_Name,
418
         Field1           => Empty_Node,
419
         Field2           => Empty_Node,
420
         Field3           => Empty_Node,
421
         Field4           => Empty_Node,
422
         Flag1            => False,
423
         Flag2            => False,
424
         Comments         => Empty_Node);
425
 
426
      --  Save the new node for the returned value
427
 
428
      Result := Project_Node_Table.Last (In_Tree.Project_Nodes);
429
 
430
      if Comments.Last > 0 then
431
 
432
         --  If this is not a node with comments, then set the flag
433
 
434
         if not Node_With_Comments (Of_Kind) then
435
            Unkept_Comments := True;
436
 
437
         elsif Of_Kind /= N_Comment and then Of_Kind /= N_Comment_Zones then
438
 
439
            Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
440
            In_Tree.Project_Nodes.Table
441
              (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
442
              (Kind             => N_Comment_Zones,
443
               Qualifier        => Unspecified,
444
               Expr_Kind        => Undefined,
445
               Location         => No_Location,
446
               Directory        => No_Path,
447
               Variables        => Empty_Node,
448
               Packages         => Empty_Node,
449
               Pkg_Id           => Empty_Package,
450
               Name             => No_Name,
451
               Src_Index        => 0,
452
               Path_Name        => No_Path,
453
               Value            => No_Name,
454
               Field1           => Empty_Node,
455
               Field2           => Empty_Node,
456
               Field3           => Empty_Node,
457
               Field4           => Empty_Node,
458
               Flag1            => False,
459
               Flag2            => False,
460
               Comments         => Empty_Node);
461
 
462
            Zone := Project_Node_Table.Last (In_Tree.Project_Nodes);
463
            In_Tree.Project_Nodes.Table (Result).Comments := Zone;
464
            Previous := Empty_Node;
465
 
466
            for J in 1 .. Comments.Last loop
467
 
468
               --  Create a new N_Comment node
469
 
470
               Project_Node_Table.Increment_Last (In_Tree.Project_Nodes);
471
               In_Tree.Project_Nodes.Table
472
                 (Project_Node_Table.Last (In_Tree.Project_Nodes)) :=
473
                 (Kind             => N_Comment,
474
                  Qualifier        => Unspecified,
475
                  Expr_Kind        => Undefined,
476
                  Flag1            => Comments.Table (J).Follows_Empty_Line,
477
                  Flag2            =>
478
                    Comments.Table (J).Is_Followed_By_Empty_Line,
479
                  Location         => No_Location,
480
                  Directory        => No_Path,
481
                  Variables        => Empty_Node,
482
                  Packages         => Empty_Node,
483
                  Pkg_Id           => Empty_Package,
484
                  Name             => No_Name,
485
                  Src_Index        => 0,
486
                  Path_Name        => No_Path,
487
                  Value            => Comments.Table (J).Value,
488
                  Field1           => Empty_Node,
489
                  Field2           => Empty_Node,
490
                  Field3           => Empty_Node,
491
                  Field4           => Empty_Node,
492
                  Comments         => Empty_Node);
493
 
494
               --  Link it to the N_Comment_Zones node, if it is the first,
495
               --  otherwise to the previous one.
496
 
497
               if No (Previous) then
498
                  In_Tree.Project_Nodes.Table (Zone).Field1 :=
499
                    Project_Node_Table.Last (In_Tree.Project_Nodes);
500
 
501
               else
502
                  In_Tree.Project_Nodes.Table (Previous).Comments :=
503
                    Project_Node_Table.Last (In_Tree.Project_Nodes);
504
               end if;
505
 
506
               --  This new node will be the previous one for the next
507
               --  N_Comment node, if there is one.
508
 
509
               Previous := Project_Node_Table.Last (In_Tree.Project_Nodes);
510
            end loop;
511
 
512
            --  Empty the Comments table after all comments have been processed
513
 
514
            Comments.Set_Last (0);
515
         end if;
516
      end if;
517
 
518
      return Result;
519
   end Default_Project_Node;
520
 
521
   ------------------
522
   -- Directory_Of --
523
   ------------------
524
 
525
   function Directory_Of
526
     (Node    : Project_Node_Id;
527
      In_Tree : Project_Node_Tree_Ref) return Path_Name_Type is
528
   begin
529
      pragma Assert
530
        (Present (Node)
531
          and then
532
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
533
      return In_Tree.Project_Nodes.Table (Node).Directory;
534
   end Directory_Of;
535
 
536
   -------------------------
537
   -- End_Of_Line_Comment --
538
   -------------------------
539
 
540
   function End_Of_Line_Comment
541
     (Node    : Project_Node_Id;
542
      In_Tree : Project_Node_Tree_Ref) return Name_Id is
543
      Zone : Project_Node_Id := Empty_Node;
544
 
545
   begin
546
      pragma Assert (Present (Node));
547
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
548
 
549
      if No (Zone) then
550
         return No_Name;
551
      else
552
         return In_Tree.Project_Nodes.Table (Zone).Value;
553
      end if;
554
   end End_Of_Line_Comment;
555
 
556
   ------------------------
557
   -- Expression_Kind_Of --
558
   ------------------------
559
 
560
   function Expression_Kind_Of
561
     (Node    : Project_Node_Id;
562
      In_Tree : Project_Node_Tree_Ref) return Variable_Kind
563
   is
564
   begin
565
      pragma Assert
566
        (Present (Node)
567
           and then -- should use Nkind_In here ??? why not???
568
             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
569
                or else
570
              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
571
                or else
572
              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
573
                or else
574
              In_Tree.Project_Nodes.Table (Node).Kind =
575
                                                  N_Typed_Variable_Declaration
576
                or else
577
              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
578
                or else
579
              In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
580
                or else
581
              In_Tree.Project_Nodes.Table (Node).Kind = N_Term
582
                or else
583
              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
584
                or else
585
              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
586
                or else
587
              In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
588
      return In_Tree.Project_Nodes.Table (Node).Expr_Kind;
589
   end Expression_Kind_Of;
590
 
591
   -------------------
592
   -- Expression_Of --
593
   -------------------
594
 
595
   function Expression_Of
596
     (Node    : Project_Node_Id;
597
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
598
   is
599
   begin
600
      pragma Assert
601
        (Present (Node)
602
          and then
603
           (In_Tree.Project_Nodes.Table (Node).Kind =
604
              N_Attribute_Declaration
605
               or else
606
            In_Tree.Project_Nodes.Table (Node).Kind =
607
              N_Typed_Variable_Declaration
608
               or else
609
            In_Tree.Project_Nodes.Table (Node).Kind =
610
              N_Variable_Declaration));
611
 
612
      return In_Tree.Project_Nodes.Table (Node).Field1;
613
   end Expression_Of;
614
 
615
   -------------------------
616
   -- Extended_Project_Of --
617
   -------------------------
618
 
619
   function Extended_Project_Of
620
     (Node    : Project_Node_Id;
621
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
622
   is
623
   begin
624
      pragma Assert
625
        (Present (Node)
626
          and then
627
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
628
      return In_Tree.Project_Nodes.Table (Node).Field2;
629
   end Extended_Project_Of;
630
 
631
   ------------------------------
632
   -- Extended_Project_Path_Of --
633
   ------------------------------
634
 
635
   function Extended_Project_Path_Of
636
     (Node    : Project_Node_Id;
637
      In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
638
   is
639
   begin
640
      pragma Assert
641
        (Present (Node)
642
          and then
643
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
644
      return Path_Name_Type (In_Tree.Project_Nodes.Table (Node).Value);
645
   end Extended_Project_Path_Of;
646
 
647
   --------------------------
648
   -- Extending_Project_Of --
649
   --------------------------
650
   function Extending_Project_Of
651
     (Node    : Project_Node_Id;
652
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
653
   is
654
   begin
655
      pragma Assert
656
        (Present (Node)
657
          and then
658
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
659
      return In_Tree.Project_Nodes.Table (Node).Field3;
660
   end Extending_Project_Of;
661
 
662
   ---------------------------
663
   -- External_Reference_Of --
664
   ---------------------------
665
 
666
   function External_Reference_Of
667
     (Node    : Project_Node_Id;
668
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
669
   is
670
   begin
671
      pragma Assert
672
        (Present (Node)
673
          and then
674
            In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
675
      return In_Tree.Project_Nodes.Table (Node).Field1;
676
   end External_Reference_Of;
677
 
678
   -------------------------
679
   -- External_Default_Of --
680
   -------------------------
681
 
682
   function External_Default_Of
683
     (Node    : Project_Node_Id;
684
      In_Tree : Project_Node_Tree_Ref)
685
      return Project_Node_Id
686
   is
687
   begin
688
      pragma Assert
689
        (Present (Node)
690
          and then
691
            In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
692
      return In_Tree.Project_Nodes.Table (Node).Field2;
693
   end External_Default_Of;
694
 
695
   ------------------------
696
   -- First_Case_Item_Of --
697
   ------------------------
698
 
699
   function First_Case_Item_Of
700
     (Node    : Project_Node_Id;
701
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
702
   is
703
   begin
704
      pragma Assert
705
        (Present (Node)
706
          and then
707
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
708
      return In_Tree.Project_Nodes.Table (Node).Field2;
709
   end First_Case_Item_Of;
710
 
711
   ---------------------
712
   -- First_Choice_Of --
713
   ---------------------
714
 
715
   function First_Choice_Of
716
     (Node    : Project_Node_Id;
717
      In_Tree : Project_Node_Tree_Ref)
718
      return Project_Node_Id
719
   is
720
   begin
721
      pragma Assert
722
        (Present (Node)
723
          and then
724
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
725
      return In_Tree.Project_Nodes.Table (Node).Field1;
726
   end First_Choice_Of;
727
 
728
   -------------------------
729
   -- First_Comment_After --
730
   -------------------------
731
 
732
   function First_Comment_After
733
     (Node    : Project_Node_Id;
734
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
735
   is
736
      Zone : Project_Node_Id := Empty_Node;
737
   begin
738
      pragma Assert (Present (Node));
739
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
740
 
741
      if No (Zone) then
742
         return Empty_Node;
743
 
744
      else
745
         return In_Tree.Project_Nodes.Table (Zone).Field2;
746
      end if;
747
   end First_Comment_After;
748
 
749
   -----------------------------
750
   -- First_Comment_After_End --
751
   -----------------------------
752
 
753
   function First_Comment_After_End
754
     (Node    : Project_Node_Id;
755
      In_Tree : Project_Node_Tree_Ref)
756
      return Project_Node_Id
757
   is
758
      Zone : Project_Node_Id := Empty_Node;
759
 
760
   begin
761
      pragma Assert (Present (Node));
762
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
763
 
764
      if No (Zone) then
765
         return Empty_Node;
766
 
767
      else
768
         return In_Tree.Project_Nodes.Table (Zone).Comments;
769
      end if;
770
   end First_Comment_After_End;
771
 
772
   --------------------------
773
   -- First_Comment_Before --
774
   --------------------------
775
 
776
   function First_Comment_Before
777
     (Node    : Project_Node_Id;
778
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
779
   is
780
      Zone : Project_Node_Id := Empty_Node;
781
 
782
   begin
783
      pragma Assert (Present (Node));
784
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
785
 
786
      if No (Zone) then
787
         return Empty_Node;
788
 
789
      else
790
         return In_Tree.Project_Nodes.Table (Zone).Field1;
791
      end if;
792
   end First_Comment_Before;
793
 
794
   ------------------------------
795
   -- First_Comment_Before_End --
796
   ------------------------------
797
 
798
   function First_Comment_Before_End
799
     (Node    : Project_Node_Id;
800
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
801
   is
802
      Zone : Project_Node_Id := Empty_Node;
803
 
804
   begin
805
      pragma Assert (Present (Node));
806
      Zone := In_Tree.Project_Nodes.Table (Node).Comments;
807
 
808
      if No (Zone) then
809
         return Empty_Node;
810
 
811
      else
812
         return In_Tree.Project_Nodes.Table (Zone).Field3;
813
      end if;
814
   end First_Comment_Before_End;
815
 
816
   -------------------------------
817
   -- First_Declarative_Item_Of --
818
   -------------------------------
819
 
820
   function First_Declarative_Item_Of
821
     (Node    : Project_Node_Id;
822
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
823
   is
824
   begin
825
      pragma Assert
826
        (Present (Node)
827
          and then
828
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
829
               or else
830
             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
831
               or else
832
             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
833
 
834
      if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
835
         return In_Tree.Project_Nodes.Table (Node).Field1;
836
      else
837
         return In_Tree.Project_Nodes.Table (Node).Field2;
838
      end if;
839
   end First_Declarative_Item_Of;
840
 
841
   ------------------------------
842
   -- First_Expression_In_List --
843
   ------------------------------
844
 
845
   function First_Expression_In_List
846
     (Node    : Project_Node_Id;
847
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
848
   is
849
   begin
850
      pragma Assert
851
        (Present (Node)
852
          and then
853
            In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
854
      return In_Tree.Project_Nodes.Table (Node).Field1;
855
   end First_Expression_In_List;
856
 
857
   --------------------------
858
   -- First_Literal_String --
859
   --------------------------
860
 
861
   function First_Literal_String
862
     (Node    : Project_Node_Id;
863
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
864
   is
865
   begin
866
      pragma Assert
867
        (Present (Node)
868
          and then
869
         In_Tree.Project_Nodes.Table (Node).Kind =
870
           N_String_Type_Declaration);
871
      return In_Tree.Project_Nodes.Table (Node).Field1;
872
   end First_Literal_String;
873
 
874
   ----------------------
875
   -- First_Package_Of --
876
   ----------------------
877
 
878
   function First_Package_Of
879
     (Node    : Project_Node_Id;
880
      In_Tree : Project_Node_Tree_Ref) return Package_Declaration_Id
881
   is
882
   begin
883
      pragma Assert
884
        (Present (Node)
885
          and then
886
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
887
      return In_Tree.Project_Nodes.Table (Node).Packages;
888
   end First_Package_Of;
889
 
890
   --------------------------
891
   -- First_String_Type_Of --
892
   --------------------------
893
 
894
   function First_String_Type_Of
895
     (Node    : Project_Node_Id;
896
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
897
   is
898
   begin
899
      pragma Assert
900
        (Present (Node)
901
          and then
902
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
903
      return In_Tree.Project_Nodes.Table (Node).Field3;
904
   end First_String_Type_Of;
905
 
906
   ----------------
907
   -- First_Term --
908
   ----------------
909
 
910
   function First_Term
911
     (Node    : Project_Node_Id;
912
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
913
   is
914
   begin
915
      pragma Assert
916
        (Present (Node)
917
          and then
918
            In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
919
      return In_Tree.Project_Nodes.Table (Node).Field1;
920
   end First_Term;
921
 
922
   -----------------------
923
   -- First_Variable_Of --
924
   -----------------------
925
 
926
   function First_Variable_Of
927
     (Node    : Project_Node_Id;
928
      In_Tree : Project_Node_Tree_Ref) return Variable_Node_Id
929
   is
930
   begin
931
      pragma Assert
932
        (Present (Node)
933
          and then
934
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
935
               or else
936
             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
937
 
938
      return In_Tree.Project_Nodes.Table (Node).Variables;
939
   end First_Variable_Of;
940
 
941
   --------------------------
942
   -- First_With_Clause_Of --
943
   --------------------------
944
 
945
   function First_With_Clause_Of
946
     (Node    : Project_Node_Id;
947
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
948
   is
949
   begin
950
      pragma Assert
951
        (Present (Node)
952
          and then
953
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
954
      return In_Tree.Project_Nodes.Table (Node).Field1;
955
   end First_With_Clause_Of;
956
 
957
   ------------------------
958
   -- Follows_Empty_Line --
959
   ------------------------
960
 
961
   function Follows_Empty_Line
962
     (Node    : Project_Node_Id;
963
      In_Tree : Project_Node_Tree_Ref) return Boolean is
964
   begin
965
      pragma Assert
966
        (Present (Node)
967
         and then
968
         In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
969
      return In_Tree.Project_Nodes.Table (Node).Flag1;
970
   end Follows_Empty_Line;
971
 
972
   ----------
973
   -- Hash --
974
   ----------
975
 
976
   function Hash (N : Project_Node_Id) return Header_Num is
977
   begin
978
      return Header_Num (N mod Project_Node_Id (Header_Num'Last));
979
   end Hash;
980
 
981
   ----------------
982
   -- Initialize --
983
   ----------------
984
 
985
   procedure Initialize (Tree : Project_Node_Tree_Ref) is
986
   begin
987
      Project_Node_Table.Init (Tree.Project_Nodes);
988
      Projects_Htable.Reset (Tree.Projects_HT);
989
   end Initialize;
990
 
991
   --------------------
992
   -- Override_Flags --
993
   --------------------
994
 
995
   procedure Override_Flags
996
     (Self  : in out Environment;
997
      Flags : Prj.Processing_Flags)
998
   is
999
   begin
1000
      Self.Flags := Flags;
1001
   end Override_Flags;
1002
 
1003
   ----------------
1004
   -- Initialize --
1005
   ----------------
1006
 
1007
   procedure Initialize
1008
     (Self      : out Environment;
1009
      Flags     : Processing_Flags) is
1010
   begin
1011
      --  Do not reset the external references, in case we are reloading a
1012
      --  project, since we want to preserve the current environment. But we
1013
      --  still need to ensure that the external references are properly
1014
      --  initialized.
1015
      --  Prj.Ext.Reset (Tree.External);
1016
 
1017
      Prj.Ext.Initialize (Self.External);
1018
 
1019
      Self.Flags := Flags;
1020
   end Initialize;
1021
 
1022
   -------------------------
1023
   -- Initialize_And_Copy --
1024
   -------------------------
1025
 
1026
   procedure Initialize_And_Copy
1027
     (Self      : out Environment;
1028
      Copy_From : Environment) is
1029
   begin
1030
      Self.Flags := Copy_From.Flags;
1031
      Prj.Ext.Initialize (Self.External, Copy_From => Copy_From.External);
1032
      Prj.Env.Copy (From => Copy_From.Project_Path, To => Self.Project_Path);
1033
   end Initialize_And_Copy;
1034
 
1035
   ----------
1036
   -- Free --
1037
   ----------
1038
 
1039
   procedure Free (Self : in out Environment) is
1040
   begin
1041
      Prj.Ext.Free (Self.External);
1042
      Free (Self.Project_Path);
1043
   end Free;
1044
 
1045
   ----------
1046
   -- Free --
1047
   ----------
1048
 
1049
   procedure Free (Proj : in out Project_Node_Tree_Ref) is
1050
      procedure Unchecked_Free is new Ada.Unchecked_Deallocation
1051
        (Project_Node_Tree_Data, Project_Node_Tree_Ref);
1052
   begin
1053
      if Proj /= null then
1054
         Project_Node_Table.Free (Proj.Project_Nodes);
1055
         Projects_Htable.Reset (Proj.Projects_HT);
1056
         Unchecked_Free (Proj);
1057
      end if;
1058
   end Free;
1059
 
1060
   -------------------------------
1061
   -- Is_Followed_By_Empty_Line --
1062
   -------------------------------
1063
 
1064
   function Is_Followed_By_Empty_Line
1065
     (Node    : Project_Node_Id;
1066
      In_Tree : Project_Node_Tree_Ref) return Boolean
1067
   is
1068
   begin
1069
      pragma Assert
1070
        (Present (Node)
1071
          and then
1072
            In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1073
      return In_Tree.Project_Nodes.Table (Node).Flag2;
1074
   end Is_Followed_By_Empty_Line;
1075
 
1076
   ----------------------
1077
   -- Is_Extending_All --
1078
   ----------------------
1079
 
1080
   function Is_Extending_All
1081
     (Node    : Project_Node_Id;
1082
      In_Tree : Project_Node_Tree_Ref) return Boolean is
1083
   begin
1084
      pragma Assert
1085
        (Present (Node)
1086
          and then
1087
           (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1088
              or else
1089
            In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1090
      return In_Tree.Project_Nodes.Table (Node).Flag2;
1091
   end Is_Extending_All;
1092
 
1093
   -------------------------
1094
   -- Is_Not_Last_In_List --
1095
   -------------------------
1096
 
1097
   function Is_Not_Last_In_List
1098
     (Node    : Project_Node_Id;
1099
      In_Tree : Project_Node_Tree_Ref) return Boolean is
1100
   begin
1101
      pragma Assert
1102
        (Present (Node)
1103
          and then
1104
            In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1105
      return In_Tree.Project_Nodes.Table (Node).Flag1;
1106
   end Is_Not_Last_In_List;
1107
 
1108
   -------------------------------------
1109
   -- Imported_Or_Extended_Project_Of --
1110
   -------------------------------------
1111
 
1112
   function Imported_Or_Extended_Project_Of
1113
     (Project   : Project_Node_Id;
1114
      In_Tree   : Project_Node_Tree_Ref;
1115
      With_Name : Name_Id) return Project_Node_Id
1116
   is
1117
      With_Clause : Project_Node_Id :=
1118
        First_With_Clause_Of (Project, In_Tree);
1119
      Result      : Project_Node_Id := Empty_Node;
1120
 
1121
   begin
1122
      --  First check all the imported projects
1123
 
1124
      while Present (With_Clause) loop
1125
 
1126
         --  Only non limited imported project may be used as prefix
1127
         --  of variable or attributes.
1128
 
1129
         Result := Non_Limited_Project_Node_Of (With_Clause, In_Tree);
1130
         exit when Present (Result)
1131
           and then Name_Of (Result, In_Tree) = With_Name;
1132
         With_Clause := Next_With_Clause_Of (With_Clause, In_Tree);
1133
      end loop;
1134
 
1135
      --  If it is not an imported project, it might be an extended project
1136
 
1137
      if No (With_Clause) then
1138
         Result := Project;
1139
         loop
1140
            Result :=
1141
              Extended_Project_Of
1142
                (Project_Declaration_Of (Result, In_Tree), In_Tree);
1143
 
1144
            exit when No (Result)
1145
              or else Name_Of (Result, In_Tree) = With_Name;
1146
         end loop;
1147
      end if;
1148
 
1149
      return Result;
1150
   end Imported_Or_Extended_Project_Of;
1151
 
1152
   -------------
1153
   -- Kind_Of --
1154
   -------------
1155
 
1156
   function Kind_Of
1157
     (Node    : Project_Node_Id;
1158
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Kind is
1159
   begin
1160
      pragma Assert (Present (Node));
1161
      return In_Tree.Project_Nodes.Table (Node).Kind;
1162
   end Kind_Of;
1163
 
1164
   -----------------
1165
   -- Location_Of --
1166
   -----------------
1167
 
1168
   function Location_Of
1169
     (Node    : Project_Node_Id;
1170
      In_Tree : Project_Node_Tree_Ref) return Source_Ptr is
1171
   begin
1172
      pragma Assert (Present (Node));
1173
      return In_Tree.Project_Nodes.Table (Node).Location;
1174
   end Location_Of;
1175
 
1176
   -------------
1177
   -- Name_Of --
1178
   -------------
1179
 
1180
   function Name_Of
1181
     (Node    : Project_Node_Id;
1182
      In_Tree : Project_Node_Tree_Ref) return Name_Id is
1183
   begin
1184
      pragma Assert (Present (Node));
1185
      return In_Tree.Project_Nodes.Table (Node).Name;
1186
   end Name_Of;
1187
 
1188
   --------------------
1189
   -- Next_Case_Item --
1190
   --------------------
1191
 
1192
   function Next_Case_Item
1193
     (Node    : Project_Node_Id;
1194
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1195
   is
1196
   begin
1197
      pragma Assert
1198
        (Present (Node)
1199
          and then
1200
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
1201
      return In_Tree.Project_Nodes.Table (Node).Field3;
1202
   end Next_Case_Item;
1203
 
1204
   ------------------
1205
   -- Next_Comment --
1206
   ------------------
1207
 
1208
   function Next_Comment
1209
     (Node    : Project_Node_Id;
1210
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id is
1211
   begin
1212
      pragma Assert
1213
        (Present (Node)
1214
          and then
1215
            In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
1216
      return In_Tree.Project_Nodes.Table (Node).Comments;
1217
   end Next_Comment;
1218
 
1219
   ---------------------------
1220
   -- Next_Declarative_Item --
1221
   ---------------------------
1222
 
1223
   function Next_Declarative_Item
1224
     (Node    : Project_Node_Id;
1225
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1226
   is
1227
   begin
1228
      pragma Assert
1229
        (Present (Node)
1230
          and then
1231
            In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1232
      return In_Tree.Project_Nodes.Table (Node).Field2;
1233
   end Next_Declarative_Item;
1234
 
1235
   -----------------------------
1236
   -- Next_Expression_In_List --
1237
   -----------------------------
1238
 
1239
   function Next_Expression_In_List
1240
     (Node    : Project_Node_Id;
1241
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1242
   is
1243
   begin
1244
      pragma Assert
1245
        (Present (Node)
1246
          and then
1247
            In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
1248
      return In_Tree.Project_Nodes.Table (Node).Field2;
1249
   end Next_Expression_In_List;
1250
 
1251
   -------------------------
1252
   -- Next_Literal_String --
1253
   -------------------------
1254
 
1255
   function Next_Literal_String
1256
     (Node    : Project_Node_Id;
1257
      In_Tree : Project_Node_Tree_Ref)
1258
      return Project_Node_Id
1259
   is
1260
   begin
1261
      pragma Assert
1262
        (Present (Node)
1263
          and then
1264
            In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
1265
      return In_Tree.Project_Nodes.Table (Node).Field1;
1266
   end Next_Literal_String;
1267
 
1268
   -----------------------------
1269
   -- Next_Package_In_Project --
1270
   -----------------------------
1271
 
1272
   function Next_Package_In_Project
1273
     (Node    : Project_Node_Id;
1274
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1275
   is
1276
   begin
1277
      pragma Assert
1278
        (Present (Node)
1279
          and then
1280
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1281
      return In_Tree.Project_Nodes.Table (Node).Field3;
1282
   end Next_Package_In_Project;
1283
 
1284
   ----------------------
1285
   -- Next_String_Type --
1286
   ----------------------
1287
 
1288
   function Next_String_Type
1289
     (Node    : Project_Node_Id;
1290
      In_Tree : Project_Node_Tree_Ref)
1291
      return Project_Node_Id
1292
   is
1293
   begin
1294
      pragma Assert
1295
        (Present (Node)
1296
          and then
1297
         In_Tree.Project_Nodes.Table (Node).Kind =
1298
           N_String_Type_Declaration);
1299
      return In_Tree.Project_Nodes.Table (Node).Field2;
1300
   end Next_String_Type;
1301
 
1302
   ---------------
1303
   -- Next_Term --
1304
   ---------------
1305
 
1306
   function Next_Term
1307
     (Node    : Project_Node_Id;
1308
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1309
   is
1310
   begin
1311
      pragma Assert
1312
        (Present (Node)
1313
          and then
1314
            In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1315
      return In_Tree.Project_Nodes.Table (Node).Field2;
1316
   end Next_Term;
1317
 
1318
   -------------------
1319
   -- Next_Variable --
1320
   -------------------
1321
 
1322
   function Next_Variable
1323
     (Node    : Project_Node_Id;
1324
      In_Tree : Project_Node_Tree_Ref)
1325
      return Project_Node_Id
1326
   is
1327
   begin
1328
      pragma Assert
1329
        (Present (Node)
1330
          and then
1331
           (In_Tree.Project_Nodes.Table (Node).Kind =
1332
              N_Typed_Variable_Declaration
1333
               or else
1334
            In_Tree.Project_Nodes.Table (Node).Kind =
1335
              N_Variable_Declaration));
1336
 
1337
      return In_Tree.Project_Nodes.Table (Node).Field3;
1338
   end Next_Variable;
1339
 
1340
   -------------------------
1341
   -- Next_With_Clause_Of --
1342
   -------------------------
1343
 
1344
   function Next_With_Clause_Of
1345
     (Node    : Project_Node_Id;
1346
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1347
   is
1348
   begin
1349
      pragma Assert
1350
        (Present (Node)
1351
          and then
1352
            In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
1353
      return In_Tree.Project_Nodes.Table (Node).Field2;
1354
   end Next_With_Clause_Of;
1355
 
1356
   --------
1357
   -- No --
1358
   --------
1359
 
1360
   function No (Node : Project_Node_Id) return Boolean is
1361
   begin
1362
      return Node = Empty_Node;
1363
   end No;
1364
 
1365
   ---------------------------------
1366
   -- Non_Limited_Project_Node_Of --
1367
   ---------------------------------
1368
 
1369
   function Non_Limited_Project_Node_Of
1370
     (Node    : Project_Node_Id;
1371
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1372
   is
1373
   begin
1374
      pragma Assert
1375
        (Present (Node)
1376
          and then
1377
           (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1378
      return In_Tree.Project_Nodes.Table (Node).Field3;
1379
   end Non_Limited_Project_Node_Of;
1380
 
1381
   -------------------
1382
   -- Package_Id_Of --
1383
   -------------------
1384
 
1385
   function Package_Id_Of
1386
     (Node    : Project_Node_Id;
1387
      In_Tree : Project_Node_Tree_Ref) return Package_Node_Id
1388
   is
1389
   begin
1390
      pragma Assert
1391
        (Present (Node)
1392
          and then
1393
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1394
      return In_Tree.Project_Nodes.Table (Node).Pkg_Id;
1395
   end Package_Id_Of;
1396
 
1397
   ---------------------
1398
   -- Package_Node_Of --
1399
   ---------------------
1400
 
1401
   function Package_Node_Of
1402
     (Node    : Project_Node_Id;
1403
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1404
   is
1405
   begin
1406
      pragma Assert
1407
        (Present (Node)
1408
          and then
1409
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1410
               or else
1411
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1412
      return In_Tree.Project_Nodes.Table (Node).Field2;
1413
   end Package_Node_Of;
1414
 
1415
   ------------------
1416
   -- Path_Name_Of --
1417
   ------------------
1418
 
1419
   function Path_Name_Of
1420
     (Node    : Project_Node_Id;
1421
      In_Tree : Project_Node_Tree_Ref) return Path_Name_Type
1422
   is
1423
   begin
1424
      pragma Assert
1425
        (Present (Node)
1426
          and then
1427
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
1428
               or else
1429
             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
1430
      return In_Tree.Project_Nodes.Table (Node).Path_Name;
1431
   end Path_Name_Of;
1432
 
1433
   -------------
1434
   -- Present --
1435
   -------------
1436
 
1437
   function Present (Node : Project_Node_Id) return Boolean is
1438
   begin
1439
      return Node /= Empty_Node;
1440
   end Present;
1441
 
1442
   ----------------------------
1443
   -- Project_Declaration_Of --
1444
   ----------------------------
1445
 
1446
   function Project_Declaration_Of
1447
     (Node    : Project_Node_Id;
1448
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1449
   is
1450
   begin
1451
      pragma Assert
1452
        (Present (Node)
1453
          and then
1454
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1455
      return In_Tree.Project_Nodes.Table (Node).Field2;
1456
   end Project_Declaration_Of;
1457
 
1458
   --------------------------
1459
   -- Project_Qualifier_Of --
1460
   --------------------------
1461
 
1462
   function Project_Qualifier_Of
1463
     (Node    : Project_Node_Id;
1464
      In_Tree : Project_Node_Tree_Ref) return Project_Qualifier
1465
   is
1466
   begin
1467
      pragma Assert
1468
        (Present (Node)
1469
          and then
1470
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1471
      return In_Tree.Project_Nodes.Table (Node).Qualifier;
1472
   end Project_Qualifier_Of;
1473
 
1474
   -----------------------
1475
   -- Parent_Project_Of --
1476
   -----------------------
1477
 
1478
   function Parent_Project_Of
1479
     (Node    : Project_Node_Id;
1480
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1481
   is
1482
   begin
1483
      pragma Assert
1484
        (Present (Node)
1485
          and then
1486
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1487
      return In_Tree.Project_Nodes.Table (Node).Field4;
1488
   end Parent_Project_Of;
1489
 
1490
   -------------------------------------------
1491
   -- Project_File_Includes_Unkept_Comments --
1492
   -------------------------------------------
1493
 
1494
   function Project_File_Includes_Unkept_Comments
1495
     (Node    : Project_Node_Id;
1496
      In_Tree : Project_Node_Tree_Ref) return Boolean
1497
   is
1498
      Declaration : constant Project_Node_Id :=
1499
                      Project_Declaration_Of (Node, In_Tree);
1500
   begin
1501
      return In_Tree.Project_Nodes.Table (Declaration).Flag1;
1502
   end Project_File_Includes_Unkept_Comments;
1503
 
1504
   ---------------------
1505
   -- Project_Node_Of --
1506
   ---------------------
1507
 
1508
   function Project_Node_Of
1509
     (Node    : Project_Node_Id;
1510
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1511
   is
1512
   begin
1513
      pragma Assert
1514
        (Present (Node)
1515
          and then
1516
           (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
1517
              or else
1518
            In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1519
              or else
1520
            In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1521
      return In_Tree.Project_Nodes.Table (Node).Field1;
1522
   end Project_Node_Of;
1523
 
1524
   -----------------------------------
1525
   -- Project_Of_Renamed_Package_Of --
1526
   -----------------------------------
1527
 
1528
   function Project_Of_Renamed_Package_Of
1529
     (Node    : Project_Node_Id;
1530
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
1531
   is
1532
   begin
1533
      pragma Assert
1534
        (Present (Node)
1535
          and then
1536
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
1537
      return In_Tree.Project_Nodes.Table (Node).Field1;
1538
   end Project_Of_Renamed_Package_Of;
1539
 
1540
   --------------------------
1541
   -- Remove_Next_End_Node --
1542
   --------------------------
1543
 
1544
   procedure Remove_Next_End_Node is
1545
   begin
1546
      Next_End_Nodes.Decrement_Last;
1547
   end Remove_Next_End_Node;
1548
 
1549
   -----------------
1550
   -- Reset_State --
1551
   -----------------
1552
 
1553
   procedure Reset_State is
1554
   begin
1555
      End_Of_Line_Node   := Empty_Node;
1556
      Previous_Line_Node := Empty_Node;
1557
      Previous_End_Node  := Empty_Node;
1558
      Unkept_Comments    := False;
1559
      Comments.Set_Last (0);
1560
   end Reset_State;
1561
 
1562
   ----------------------
1563
   -- Restore_And_Free --
1564
   ----------------------
1565
 
1566
   procedure Restore_And_Free (S : in out Comment_State) is
1567
      procedure Unchecked_Free is new
1568
        Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
1569
 
1570
   begin
1571
      End_Of_Line_Node   := S.End_Of_Line_Node;
1572
      Previous_Line_Node := S.Previous_Line_Node;
1573
      Previous_End_Node  := S.Previous_End_Node;
1574
      Next_End_Nodes.Set_Last (0);
1575
      Unkept_Comments    := S.Unkept_Comments;
1576
 
1577
      Comments.Set_Last (0);
1578
 
1579
      for J in S.Comments'Range loop
1580
         Comments.Increment_Last;
1581
         Comments.Table (Comments.Last) := S.Comments (J);
1582
      end loop;
1583
 
1584
      Unchecked_Free (S.Comments);
1585
   end Restore_And_Free;
1586
 
1587
   ----------
1588
   -- Save --
1589
   ----------
1590
 
1591
   procedure Save (S : out Comment_State) is
1592
      Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
1593
 
1594
   begin
1595
      for J in 1 .. Comments.Last loop
1596
         Cmts (J) := Comments.Table (J);
1597
      end loop;
1598
 
1599
      S :=
1600
        (End_Of_Line_Node   => End_Of_Line_Node,
1601
         Previous_Line_Node => Previous_Line_Node,
1602
         Previous_End_Node  => Previous_End_Node,
1603
         Unkept_Comments    => Unkept_Comments,
1604
         Comments           => Cmts);
1605
   end Save;
1606
 
1607
   ----------
1608
   -- Scan --
1609
   ----------
1610
 
1611
   procedure Scan (In_Tree : Project_Node_Tree_Ref) is
1612
      Empty_Line : Boolean := False;
1613
 
1614
   begin
1615
      --  If there are comments, then they will not be kept. Set the flag and
1616
      --  clear the comments.
1617
 
1618
      if Comments.Last > 0 then
1619
         Unkept_Comments := True;
1620
         Comments.Set_Last (0);
1621
      end if;
1622
 
1623
      --  Loop until a token other that End_Of_Line or Comment is found
1624
 
1625
      loop
1626
         Prj.Err.Scanner.Scan;
1627
 
1628
         case Token is
1629
            when Tok_End_Of_Line =>
1630
               if Prev_Token = Tok_End_Of_Line then
1631
                  Empty_Line := True;
1632
 
1633
                  if Comments.Last > 0 then
1634
                     Comments.Table (Comments.Last).Is_Followed_By_Empty_Line
1635
                     := True;
1636
                  end if;
1637
               end if;
1638
 
1639
            when Tok_Comment =>
1640
               --  If this is a line comment, add it to the comment table
1641
 
1642
               if Prev_Token = Tok_End_Of_Line
1643
                 or else Prev_Token = No_Token
1644
               then
1645
                  Comments.Increment_Last;
1646
                  Comments.Table (Comments.Last) :=
1647
                    (Value                     => Comment_Id,
1648
                     Follows_Empty_Line        => Empty_Line,
1649
                     Is_Followed_By_Empty_Line => False);
1650
 
1651
               --  Otherwise, it is an end of line comment. If there is
1652
               --  an end of line node specified, associate the comment with
1653
               --  this node.
1654
 
1655
               elsif Present (End_Of_Line_Node) then
1656
                  declare
1657
                     Zones : constant Project_Node_Id :=
1658
                               Comment_Zones_Of (End_Of_Line_Node, In_Tree);
1659
                  begin
1660
                     In_Tree.Project_Nodes.Table (Zones).Value := Comment_Id;
1661
                  end;
1662
 
1663
               --  Otherwise, this end of line node cannot be kept
1664
 
1665
               else
1666
                  Unkept_Comments := True;
1667
                  Comments.Set_Last (0);
1668
               end if;
1669
 
1670
               Empty_Line := False;
1671
 
1672
            when others =>
1673
               --  If there are comments, where the first comment is not
1674
               --  following an empty line, put the initial uninterrupted
1675
               --  comment zone with the node of the preceding line (either
1676
               --  a Previous_Line or a Previous_End node), if any.
1677
 
1678
               if Comments.Last > 0 and then
1679
                 not Comments.Table (1).Follows_Empty_Line then
1680
                  if Present (Previous_Line_Node) then
1681
                     Add_Comments
1682
                       (To      => Previous_Line_Node,
1683
                        Where   => After,
1684
                        In_Tree => In_Tree);
1685
 
1686
                  elsif Present (Previous_End_Node) then
1687
                     Add_Comments
1688
                       (To      => Previous_End_Node,
1689
                        Where   => After_End,
1690
                        In_Tree => In_Tree);
1691
                  end if;
1692
               end if;
1693
 
1694
               --  If there are still comments and the token is "end", then
1695
               --  put these comments with the Next_End node, if any;
1696
               --  otherwise, these comments cannot be kept. Always clear
1697
               --  the comments.
1698
 
1699
               if Comments.Last > 0 and then Token = Tok_End then
1700
                  if Next_End_Nodes.Last > 0 then
1701
                     Add_Comments
1702
                       (To      => Next_End_Nodes.Table (Next_End_Nodes.Last),
1703
                        Where   => Before_End,
1704
                        In_Tree => In_Tree);
1705
 
1706
                  else
1707
                     Unkept_Comments := True;
1708
                  end if;
1709
 
1710
                  Comments.Set_Last (0);
1711
               end if;
1712
 
1713
               --  Reset the End_Of_Line, Previous_Line and Previous_End nodes
1714
               --  so that they are not used again.
1715
 
1716
               End_Of_Line_Node   := Empty_Node;
1717
               Previous_Line_Node := Empty_Node;
1718
               Previous_End_Node  := Empty_Node;
1719
 
1720
               --  And return
1721
 
1722
               exit;
1723
         end case;
1724
      end loop;
1725
   end Scan;
1726
 
1727
   ------------------------------------
1728
   -- Set_Associative_Array_Index_Of --
1729
   ------------------------------------
1730
 
1731
   procedure Set_Associative_Array_Index_Of
1732
     (Node    : Project_Node_Id;
1733
      In_Tree : Project_Node_Tree_Ref;
1734
      To      : Name_Id)
1735
   is
1736
   begin
1737
      pragma Assert
1738
        (Present (Node)
1739
          and then
1740
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1741
               or else
1742
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1743
      In_Tree.Project_Nodes.Table (Node).Value := To;
1744
   end Set_Associative_Array_Index_Of;
1745
 
1746
   --------------------------------
1747
   -- Set_Associative_Package_Of --
1748
   --------------------------------
1749
 
1750
   procedure Set_Associative_Package_Of
1751
     (Node    : Project_Node_Id;
1752
      In_Tree : Project_Node_Tree_Ref;
1753
      To      : Project_Node_Id)
1754
   is
1755
   begin
1756
      pragma Assert
1757
         (Present (Node)
1758
          and then
1759
            In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration);
1760
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
1761
   end Set_Associative_Package_Of;
1762
 
1763
   --------------------------------
1764
   -- Set_Associative_Project_Of --
1765
   --------------------------------
1766
 
1767
   procedure Set_Associative_Project_Of
1768
     (Node    : Project_Node_Id;
1769
      In_Tree : Project_Node_Tree_Ref;
1770
      To      : Project_Node_Id)
1771
   is
1772
   begin
1773
      pragma Assert
1774
        (Present (Node)
1775
          and then
1776
           (In_Tree.Project_Nodes.Table (Node).Kind =
1777
              N_Attribute_Declaration));
1778
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
1779
   end Set_Associative_Project_Of;
1780
 
1781
   --------------------------
1782
   -- Set_Case_Insensitive --
1783
   --------------------------
1784
 
1785
   procedure Set_Case_Insensitive
1786
     (Node    : Project_Node_Id;
1787
      In_Tree : Project_Node_Tree_Ref;
1788
      To      : Boolean)
1789
   is
1790
   begin
1791
      pragma Assert
1792
        (Present (Node)
1793
          and then
1794
           (In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1795
               or else
1796
            In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
1797
      In_Tree.Project_Nodes.Table (Node).Flag1 := To;
1798
   end Set_Case_Insensitive;
1799
 
1800
   ------------------------------------
1801
   -- Set_Case_Variable_Reference_Of --
1802
   ------------------------------------
1803
 
1804
   procedure Set_Case_Variable_Reference_Of
1805
     (Node    : Project_Node_Id;
1806
      In_Tree : Project_Node_Tree_Ref;
1807
      To      : Project_Node_Id)
1808
   is
1809
   begin
1810
      pragma Assert
1811
        (Present (Node)
1812
          and then
1813
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1814
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
1815
   end Set_Case_Variable_Reference_Of;
1816
 
1817
   ---------------------------
1818
   -- Set_Current_Item_Node --
1819
   ---------------------------
1820
 
1821
   procedure Set_Current_Item_Node
1822
     (Node    : Project_Node_Id;
1823
      In_Tree : Project_Node_Tree_Ref;
1824
      To      : Project_Node_Id)
1825
   is
1826
   begin
1827
      pragma Assert
1828
        (Present (Node)
1829
          and then
1830
            In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
1831
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
1832
   end Set_Current_Item_Node;
1833
 
1834
   ----------------------
1835
   -- Set_Current_Term --
1836
   ----------------------
1837
 
1838
   procedure Set_Current_Term
1839
     (Node    : Project_Node_Id;
1840
      In_Tree : Project_Node_Tree_Ref;
1841
      To      : Project_Node_Id)
1842
   is
1843
   begin
1844
      pragma Assert
1845
        (Present (Node)
1846
          and then
1847
            In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
1848
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
1849
   end Set_Current_Term;
1850
 
1851
   ----------------------
1852
   -- Set_Directory_Of --
1853
   ----------------------
1854
 
1855
   procedure Set_Directory_Of
1856
     (Node    : Project_Node_Id;
1857
      In_Tree : Project_Node_Tree_Ref;
1858
      To      : Path_Name_Type)
1859
   is
1860
   begin
1861
      pragma Assert
1862
        (Present (Node)
1863
          and then
1864
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
1865
      In_Tree.Project_Nodes.Table (Node).Directory := To;
1866
   end Set_Directory_Of;
1867
 
1868
   ---------------------
1869
   -- Set_End_Of_Line --
1870
   ---------------------
1871
 
1872
   procedure Set_End_Of_Line (To : Project_Node_Id) is
1873
   begin
1874
      End_Of_Line_Node := To;
1875
   end Set_End_Of_Line;
1876
 
1877
   ----------------------------
1878
   -- Set_Expression_Kind_Of --
1879
   ----------------------------
1880
 
1881
   procedure Set_Expression_Kind_Of
1882
     (Node    : Project_Node_Id;
1883
      In_Tree : Project_Node_Tree_Ref;
1884
      To      : Variable_Kind)
1885
   is
1886
   begin
1887
      pragma Assert
1888
        (Present (Node)
1889
           and then -- should use Nkind_In here ??? why not???
1890
             (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
1891
                or else
1892
              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Declaration
1893
                or else
1894
              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Declaration
1895
                or else
1896
              In_Tree.Project_Nodes.Table (Node).Kind =
1897
                                                  N_Typed_Variable_Declaration
1898
                or else
1899
              In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration
1900
                or else
1901
              In_Tree.Project_Nodes.Table (Node).Kind = N_Expression
1902
                or else
1903
              In_Tree.Project_Nodes.Table (Node).Kind = N_Term
1904
                or else
1905
              In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
1906
                or else
1907
              In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference
1908
                or else
1909
              In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value));
1910
      In_Tree.Project_Nodes.Table (Node).Expr_Kind := To;
1911
   end Set_Expression_Kind_Of;
1912
 
1913
   -----------------------
1914
   -- Set_Expression_Of --
1915
   -----------------------
1916
 
1917
   procedure Set_Expression_Of
1918
     (Node    : Project_Node_Id;
1919
      In_Tree : Project_Node_Tree_Ref;
1920
      To      : Project_Node_Id)
1921
   is
1922
   begin
1923
      pragma Assert
1924
        (Present (Node)
1925
          and then
1926
           (In_Tree.Project_Nodes.Table (Node).Kind =
1927
              N_Attribute_Declaration
1928
               or else
1929
            In_Tree.Project_Nodes.Table (Node).Kind =
1930
              N_Typed_Variable_Declaration
1931
               or else
1932
            In_Tree.Project_Nodes.Table (Node).Kind =
1933
              N_Variable_Declaration));
1934
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
1935
   end Set_Expression_Of;
1936
 
1937
   -------------------------------
1938
   -- Set_External_Reference_Of --
1939
   -------------------------------
1940
 
1941
   procedure Set_External_Reference_Of
1942
     (Node    : Project_Node_Id;
1943
      In_Tree : Project_Node_Tree_Ref;
1944
      To      : Project_Node_Id)
1945
   is
1946
   begin
1947
      pragma Assert
1948
        (Present (Node)
1949
          and then
1950
            In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1951
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
1952
   end Set_External_Reference_Of;
1953
 
1954
   -----------------------------
1955
   -- Set_External_Default_Of --
1956
   -----------------------------
1957
 
1958
   procedure Set_External_Default_Of
1959
     (Node    : Project_Node_Id;
1960
      In_Tree : Project_Node_Tree_Ref;
1961
      To      : Project_Node_Id)
1962
   is
1963
   begin
1964
      pragma Assert
1965
        (Present (Node)
1966
          and then
1967
            In_Tree.Project_Nodes.Table (Node).Kind = N_External_Value);
1968
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
1969
   end Set_External_Default_Of;
1970
 
1971
   ----------------------------
1972
   -- Set_First_Case_Item_Of --
1973
   ----------------------------
1974
 
1975
   procedure Set_First_Case_Item_Of
1976
     (Node    : Project_Node_Id;
1977
      In_Tree : Project_Node_Tree_Ref;
1978
      To      : Project_Node_Id)
1979
   is
1980
   begin
1981
      pragma Assert
1982
        (Present (Node)
1983
          and then
1984
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Construction);
1985
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
1986
   end Set_First_Case_Item_Of;
1987
 
1988
   -------------------------
1989
   -- Set_First_Choice_Of --
1990
   -------------------------
1991
 
1992
   procedure Set_First_Choice_Of
1993
     (Node    : Project_Node_Id;
1994
      In_Tree : Project_Node_Tree_Ref;
1995
      To      : Project_Node_Id)
1996
   is
1997
   begin
1998
      pragma Assert
1999
        (Present (Node)
2000
          and then
2001
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2002
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2003
   end Set_First_Choice_Of;
2004
 
2005
   -----------------------------
2006
   -- Set_First_Comment_After --
2007
   -----------------------------
2008
 
2009
   procedure Set_First_Comment_After
2010
     (Node    : Project_Node_Id;
2011
      In_Tree : Project_Node_Tree_Ref;
2012
      To      : Project_Node_Id)
2013
   is
2014
      Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2015
   begin
2016
      In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2017
   end Set_First_Comment_After;
2018
 
2019
   ---------------------------------
2020
   -- Set_First_Comment_After_End --
2021
   ---------------------------------
2022
 
2023
   procedure Set_First_Comment_After_End
2024
     (Node    : Project_Node_Id;
2025
      In_Tree : Project_Node_Tree_Ref;
2026
      To      : Project_Node_Id)
2027
   is
2028
      Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2029
   begin
2030
      In_Tree.Project_Nodes.Table (Zone).Comments := To;
2031
   end Set_First_Comment_After_End;
2032
 
2033
   ------------------------------
2034
   -- Set_First_Comment_Before --
2035
   ------------------------------
2036
 
2037
   procedure Set_First_Comment_Before
2038
     (Node    : Project_Node_Id;
2039
      In_Tree : Project_Node_Tree_Ref;
2040
      To      : Project_Node_Id)
2041
 
2042
   is
2043
      Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2044
   begin
2045
      In_Tree.Project_Nodes.Table (Zone).Field1 := To;
2046
   end Set_First_Comment_Before;
2047
 
2048
   ----------------------------------
2049
   -- Set_First_Comment_Before_End --
2050
   ----------------------------------
2051
 
2052
   procedure Set_First_Comment_Before_End
2053
     (Node    : Project_Node_Id;
2054
      In_Tree : Project_Node_Tree_Ref;
2055
      To      : Project_Node_Id)
2056
   is
2057
      Zone : constant Project_Node_Id := Comment_Zones_Of (Node, In_Tree);
2058
   begin
2059
      In_Tree.Project_Nodes.Table (Zone).Field2 := To;
2060
   end Set_First_Comment_Before_End;
2061
 
2062
   ------------------------
2063
   -- Set_Next_Case_Item --
2064
   ------------------------
2065
 
2066
   procedure Set_Next_Case_Item
2067
     (Node    : Project_Node_Id;
2068
      In_Tree : Project_Node_Tree_Ref;
2069
      To      : Project_Node_Id)
2070
   is
2071
   begin
2072
      pragma Assert
2073
        (Present (Node)
2074
          and then
2075
            In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item);
2076
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
2077
   end Set_Next_Case_Item;
2078
 
2079
   ----------------------
2080
   -- Set_Next_Comment --
2081
   ----------------------
2082
 
2083
   procedure Set_Next_Comment
2084
     (Node    : Project_Node_Id;
2085
      In_Tree : Project_Node_Tree_Ref;
2086
      To      : Project_Node_Id)
2087
   is
2088
   begin
2089
      pragma Assert
2090
        (Present (Node)
2091
          and then
2092
            In_Tree.Project_Nodes.Table (Node).Kind = N_Comment);
2093
      In_Tree.Project_Nodes.Table (Node).Comments := To;
2094
   end Set_Next_Comment;
2095
 
2096
   -----------------------------------
2097
   -- Set_First_Declarative_Item_Of --
2098
   -----------------------------------
2099
 
2100
   procedure Set_First_Declarative_Item_Of
2101
     (Node    : Project_Node_Id;
2102
      In_Tree : Project_Node_Tree_Ref;
2103
      To      : Project_Node_Id)
2104
   is
2105
   begin
2106
      pragma Assert
2107
        (Present (Node)
2108
          and then
2109
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration
2110
               or else
2111
             In_Tree.Project_Nodes.Table (Node).Kind = N_Case_Item
2112
               or else
2113
             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2114
 
2115
      if In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration then
2116
         In_Tree.Project_Nodes.Table (Node).Field1 := To;
2117
      else
2118
         In_Tree.Project_Nodes.Table (Node).Field2 := To;
2119
      end if;
2120
   end Set_First_Declarative_Item_Of;
2121
 
2122
   ----------------------------------
2123
   -- Set_First_Expression_In_List --
2124
   ----------------------------------
2125
 
2126
   procedure Set_First_Expression_In_List
2127
     (Node    : Project_Node_Id;
2128
      In_Tree : Project_Node_Tree_Ref;
2129
      To      : Project_Node_Id)
2130
   is
2131
   begin
2132
      pragma Assert
2133
        (Present (Node)
2134
          and then
2135
            In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String_List);
2136
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2137
   end Set_First_Expression_In_List;
2138
 
2139
   ------------------------------
2140
   -- Set_First_Literal_String --
2141
   ------------------------------
2142
 
2143
   procedure Set_First_Literal_String
2144
     (Node    : Project_Node_Id;
2145
      In_Tree : Project_Node_Tree_Ref;
2146
      To      : Project_Node_Id)
2147
   is
2148
   begin
2149
      pragma Assert
2150
        (Present (Node)
2151
          and then
2152
         In_Tree.Project_Nodes.Table (Node).Kind =
2153
           N_String_Type_Declaration);
2154
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2155
   end Set_First_Literal_String;
2156
 
2157
   --------------------------
2158
   -- Set_First_Package_Of --
2159
   --------------------------
2160
 
2161
   procedure Set_First_Package_Of
2162
     (Node    : Project_Node_Id;
2163
      In_Tree : Project_Node_Tree_Ref;
2164
      To      : Package_Declaration_Id)
2165
   is
2166
   begin
2167
      pragma Assert
2168
        (Present (Node)
2169
          and then
2170
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2171
      In_Tree.Project_Nodes.Table (Node).Packages := To;
2172
   end Set_First_Package_Of;
2173
 
2174
   ------------------------------
2175
   -- Set_First_String_Type_Of --
2176
   ------------------------------
2177
 
2178
   procedure Set_First_String_Type_Of
2179
     (Node    : Project_Node_Id;
2180
      In_Tree : Project_Node_Tree_Ref;
2181
      To      : Project_Node_Id)
2182
   is
2183
   begin
2184
      pragma Assert
2185
        (Present (Node)
2186
          and then
2187
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2188
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
2189
   end Set_First_String_Type_Of;
2190
 
2191
   --------------------
2192
   -- Set_First_Term --
2193
   --------------------
2194
 
2195
   procedure Set_First_Term
2196
     (Node    : Project_Node_Id;
2197
      In_Tree : Project_Node_Tree_Ref;
2198
      To      : Project_Node_Id)
2199
   is
2200
   begin
2201
      pragma Assert
2202
        (Present (Node)
2203
          and then
2204
            In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2205
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2206
   end Set_First_Term;
2207
 
2208
   ---------------------------
2209
   -- Set_First_Variable_Of --
2210
   ---------------------------
2211
 
2212
   procedure Set_First_Variable_Of
2213
     (Node    : Project_Node_Id;
2214
      In_Tree : Project_Node_Tree_Ref;
2215
      To      : Variable_Node_Id)
2216
   is
2217
   begin
2218
      pragma Assert
2219
        (Present (Node)
2220
          and then
2221
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2222
               or else
2223
             In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration));
2224
      In_Tree.Project_Nodes.Table (Node).Variables := To;
2225
   end Set_First_Variable_Of;
2226
 
2227
   ------------------------------
2228
   -- Set_First_With_Clause_Of --
2229
   ------------------------------
2230
 
2231
   procedure Set_First_With_Clause_Of
2232
     (Node    : Project_Node_Id;
2233
      In_Tree : Project_Node_Tree_Ref;
2234
      To      : Project_Node_Id)
2235
   is
2236
   begin
2237
      pragma Assert
2238
        (Present (Node)
2239
          and then
2240
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2241
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2242
   end Set_First_With_Clause_Of;
2243
 
2244
   --------------------------
2245
   -- Set_Is_Extending_All --
2246
   --------------------------
2247
 
2248
   procedure Set_Is_Extending_All
2249
     (Node    : Project_Node_Id;
2250
      In_Tree : Project_Node_Tree_Ref)
2251
   is
2252
   begin
2253
      pragma Assert
2254
        (Present (Node)
2255
          and then
2256
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2257
               or else
2258
             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2259
      In_Tree.Project_Nodes.Table (Node).Flag2 := True;
2260
   end Set_Is_Extending_All;
2261
 
2262
   -----------------------------
2263
   -- Set_Is_Not_Last_In_List --
2264
   -----------------------------
2265
 
2266
   procedure Set_Is_Not_Last_In_List
2267
     (Node    : Project_Node_Id;
2268
      In_Tree : Project_Node_Tree_Ref)
2269
   is
2270
   begin
2271
      pragma Assert
2272
        (Present (Node)
2273
          and then In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2274
      In_Tree.Project_Nodes.Table (Node).Flag1 := True;
2275
   end Set_Is_Not_Last_In_List;
2276
 
2277
   -----------------
2278
   -- Set_Kind_Of --
2279
   -----------------
2280
 
2281
   procedure Set_Kind_Of
2282
     (Node    : Project_Node_Id;
2283
      In_Tree : Project_Node_Tree_Ref;
2284
      To      : Project_Node_Kind)
2285
   is
2286
   begin
2287
      pragma Assert (Present (Node));
2288
      In_Tree.Project_Nodes.Table (Node).Kind := To;
2289
   end Set_Kind_Of;
2290
 
2291
   ---------------------
2292
   -- Set_Location_Of --
2293
   ---------------------
2294
 
2295
   procedure Set_Location_Of
2296
     (Node    : Project_Node_Id;
2297
      In_Tree : Project_Node_Tree_Ref;
2298
      To      : Source_Ptr)
2299
   is
2300
   begin
2301
      pragma Assert (Present (Node));
2302
      In_Tree.Project_Nodes.Table (Node).Location := To;
2303
   end Set_Location_Of;
2304
 
2305
   -----------------------------
2306
   -- Set_Extended_Project_Of --
2307
   -----------------------------
2308
 
2309
   procedure Set_Extended_Project_Of
2310
     (Node    : Project_Node_Id;
2311
      In_Tree : Project_Node_Tree_Ref;
2312
      To      : Project_Node_Id)
2313
   is
2314
   begin
2315
      pragma Assert
2316
        (Present (Node)
2317
          and then
2318
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2319
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2320
   end Set_Extended_Project_Of;
2321
 
2322
   ----------------------------------
2323
   -- Set_Extended_Project_Path_Of --
2324
   ----------------------------------
2325
 
2326
   procedure Set_Extended_Project_Path_Of
2327
     (Node    : Project_Node_Id;
2328
      In_Tree : Project_Node_Tree_Ref;
2329
      To      : Path_Name_Type)
2330
   is
2331
   begin
2332
      pragma Assert
2333
        (Present (Node)
2334
          and then
2335
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2336
      In_Tree.Project_Nodes.Table (Node).Value := Name_Id (To);
2337
   end Set_Extended_Project_Path_Of;
2338
 
2339
   ------------------------------
2340
   -- Set_Extending_Project_Of --
2341
   ------------------------------
2342
 
2343
   procedure Set_Extending_Project_Of
2344
     (Node    : Project_Node_Id;
2345
      In_Tree : Project_Node_Tree_Ref;
2346
      To      : Project_Node_Id)
2347
   is
2348
   begin
2349
      pragma Assert
2350
        (Present (Node)
2351
          and then
2352
            In_Tree.Project_Nodes.Table (Node).Kind = N_Project_Declaration);
2353
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
2354
   end Set_Extending_Project_Of;
2355
 
2356
   -----------------
2357
   -- Set_Name_Of --
2358
   -----------------
2359
 
2360
   procedure Set_Name_Of
2361
     (Node    : Project_Node_Id;
2362
      In_Tree : Project_Node_Tree_Ref;
2363
      To      : Name_Id)
2364
   is
2365
   begin
2366
      pragma Assert (Present (Node));
2367
      In_Tree.Project_Nodes.Table (Node).Name := To;
2368
   end Set_Name_Of;
2369
 
2370
   -------------------------------
2371
   -- Set_Next_Declarative_Item --
2372
   -------------------------------
2373
 
2374
   procedure Set_Next_Declarative_Item
2375
     (Node    : Project_Node_Id;
2376
      In_Tree : Project_Node_Tree_Ref;
2377
      To      : Project_Node_Id)
2378
   is
2379
   begin
2380
      pragma Assert
2381
        (Present (Node)
2382
          and then
2383
            In_Tree.Project_Nodes.Table (Node).Kind = N_Declarative_Item);
2384
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2385
   end Set_Next_Declarative_Item;
2386
 
2387
   -----------------------
2388
   -- Set_Next_End_Node --
2389
   -----------------------
2390
 
2391
   procedure Set_Next_End_Node (To : Project_Node_Id) is
2392
   begin
2393
      Next_End_Nodes.Increment_Last;
2394
      Next_End_Nodes.Table (Next_End_Nodes.Last) := To;
2395
   end Set_Next_End_Node;
2396
 
2397
   ---------------------------------
2398
   -- Set_Next_Expression_In_List --
2399
   ---------------------------------
2400
 
2401
   procedure Set_Next_Expression_In_List
2402
     (Node    : Project_Node_Id;
2403
      In_Tree : Project_Node_Tree_Ref;
2404
      To      : Project_Node_Id)
2405
   is
2406
   begin
2407
      pragma Assert
2408
        (Present (Node)
2409
          and then
2410
            In_Tree.Project_Nodes.Table (Node).Kind = N_Expression);
2411
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2412
   end Set_Next_Expression_In_List;
2413
 
2414
   -----------------------------
2415
   -- Set_Next_Literal_String --
2416
   -----------------------------
2417
 
2418
   procedure Set_Next_Literal_String
2419
     (Node    : Project_Node_Id;
2420
      In_Tree : Project_Node_Tree_Ref;
2421
      To      : Project_Node_Id)
2422
   is
2423
   begin
2424
      pragma Assert
2425
        (Present (Node)
2426
          and then
2427
            In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String);
2428
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2429
   end Set_Next_Literal_String;
2430
 
2431
   ---------------------------------
2432
   -- Set_Next_Package_In_Project --
2433
   ---------------------------------
2434
 
2435
   procedure Set_Next_Package_In_Project
2436
     (Node    : Project_Node_Id;
2437
      In_Tree : Project_Node_Tree_Ref;
2438
      To      : Project_Node_Id)
2439
   is
2440
   begin
2441
      pragma Assert
2442
        (Present (Node)
2443
          and then
2444
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2445
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
2446
   end Set_Next_Package_In_Project;
2447
 
2448
   --------------------------
2449
   -- Set_Next_String_Type --
2450
   --------------------------
2451
 
2452
   procedure Set_Next_String_Type
2453
     (Node    : Project_Node_Id;
2454
      In_Tree : Project_Node_Tree_Ref;
2455
      To      : Project_Node_Id)
2456
   is
2457
   begin
2458
      pragma Assert
2459
        (Present (Node)
2460
          and then
2461
         In_Tree.Project_Nodes.Table (Node).Kind =
2462
           N_String_Type_Declaration);
2463
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2464
   end Set_Next_String_Type;
2465
 
2466
   -------------------
2467
   -- Set_Next_Term --
2468
   -------------------
2469
 
2470
   procedure Set_Next_Term
2471
     (Node    : Project_Node_Id;
2472
      In_Tree : Project_Node_Tree_Ref;
2473
      To      : Project_Node_Id)
2474
   is
2475
   begin
2476
      pragma Assert
2477
        (Present (Node)
2478
          and then
2479
            In_Tree.Project_Nodes.Table (Node).Kind = N_Term);
2480
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2481
   end Set_Next_Term;
2482
 
2483
   -----------------------
2484
   -- Set_Next_Variable --
2485
   -----------------------
2486
 
2487
   procedure Set_Next_Variable
2488
     (Node    : Project_Node_Id;
2489
      In_Tree : Project_Node_Tree_Ref;
2490
      To      : Project_Node_Id)
2491
   is
2492
   begin
2493
      pragma Assert
2494
        (Present (Node)
2495
          and then
2496
           (In_Tree.Project_Nodes.Table (Node).Kind =
2497
              N_Typed_Variable_Declaration
2498
               or else
2499
            In_Tree.Project_Nodes.Table (Node).Kind =
2500
              N_Variable_Declaration));
2501
      In_Tree.Project_Nodes.Table (Node).Field3 := To;
2502
   end Set_Next_Variable;
2503
 
2504
   -----------------------------
2505
   -- Set_Next_With_Clause_Of --
2506
   -----------------------------
2507
 
2508
   procedure Set_Next_With_Clause_Of
2509
     (Node    : Project_Node_Id;
2510
      In_Tree : Project_Node_Tree_Ref;
2511
      To      : Project_Node_Id)
2512
   is
2513
   begin
2514
      pragma Assert
2515
        (Present (Node)
2516
          and then
2517
            In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause);
2518
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2519
   end Set_Next_With_Clause_Of;
2520
 
2521
   -----------------------
2522
   -- Set_Package_Id_Of --
2523
   -----------------------
2524
 
2525
   procedure Set_Package_Id_Of
2526
     (Node    : Project_Node_Id;
2527
      In_Tree : Project_Node_Tree_Ref;
2528
      To      : Package_Node_Id)
2529
   is
2530
   begin
2531
      pragma Assert
2532
        (Present (Node)
2533
          and then
2534
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2535
      In_Tree.Project_Nodes.Table (Node).Pkg_Id := To;
2536
   end Set_Package_Id_Of;
2537
 
2538
   -------------------------
2539
   -- Set_Package_Node_Of --
2540
   -------------------------
2541
 
2542
   procedure Set_Package_Node_Of
2543
     (Node    : Project_Node_Id;
2544
      In_Tree : Project_Node_Tree_Ref;
2545
      To      : Project_Node_Id)
2546
   is
2547
   begin
2548
      pragma Assert
2549
        (Present (Node)
2550
          and then
2551
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2552
               or else
2553
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2554
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2555
   end Set_Package_Node_Of;
2556
 
2557
   ----------------------
2558
   -- Set_Path_Name_Of --
2559
   ----------------------
2560
 
2561
   procedure Set_Path_Name_Of
2562
     (Node    : Project_Node_Id;
2563
      In_Tree : Project_Node_Tree_Ref;
2564
      To      : Path_Name_Type)
2565
   is
2566
   begin
2567
      pragma Assert
2568
        (Present (Node)
2569
          and then
2570
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Project
2571
               or else
2572
             In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause));
2573
      In_Tree.Project_Nodes.Table (Node).Path_Name := To;
2574
   end Set_Path_Name_Of;
2575
 
2576
   ---------------------------
2577
   -- Set_Previous_End_Node --
2578
   ---------------------------
2579
   procedure Set_Previous_End_Node (To : Project_Node_Id) is
2580
   begin
2581
      Previous_End_Node := To;
2582
   end Set_Previous_End_Node;
2583
 
2584
   ----------------------------
2585
   -- Set_Previous_Line_Node --
2586
   ----------------------------
2587
 
2588
   procedure Set_Previous_Line_Node (To : Project_Node_Id) is
2589
   begin
2590
      Previous_Line_Node := To;
2591
   end Set_Previous_Line_Node;
2592
 
2593
   --------------------------------
2594
   -- Set_Project_Declaration_Of --
2595
   --------------------------------
2596
 
2597
   procedure Set_Project_Declaration_Of
2598
     (Node    : Project_Node_Id;
2599
      In_Tree : Project_Node_Tree_Ref;
2600
      To      : Project_Node_Id)
2601
   is
2602
   begin
2603
      pragma Assert
2604
        (Present (Node)
2605
         and then
2606
           In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2607
      In_Tree.Project_Nodes.Table (Node).Field2 := To;
2608
   end Set_Project_Declaration_Of;
2609
 
2610
   ------------------------------
2611
   -- Set_Project_Qualifier_Of --
2612
   ------------------------------
2613
 
2614
   procedure Set_Project_Qualifier_Of
2615
     (Node    : Project_Node_Id;
2616
      In_Tree : Project_Node_Tree_Ref;
2617
      To      : Project_Qualifier)
2618
   is
2619
   begin
2620
      pragma Assert
2621
        (Present (Node)
2622
          and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2623
      In_Tree.Project_Nodes.Table (Node).Qualifier := To;
2624
   end Set_Project_Qualifier_Of;
2625
 
2626
   ---------------------------
2627
   -- Set_Parent_Project_Of --
2628
   ---------------------------
2629
 
2630
   procedure Set_Parent_Project_Of
2631
     (Node    : Project_Node_Id;
2632
      In_Tree : Project_Node_Tree_Ref;
2633
      To      : Project_Node_Id)
2634
   is
2635
   begin
2636
      pragma Assert
2637
        (Present (Node)
2638
          and then In_Tree.Project_Nodes.Table (Node).Kind = N_Project);
2639
      In_Tree.Project_Nodes.Table (Node).Field4 := To;
2640
   end Set_Parent_Project_Of;
2641
 
2642
   -----------------------------------------------
2643
   -- Set_Project_File_Includes_Unkept_Comments --
2644
   -----------------------------------------------
2645
 
2646
   procedure Set_Project_File_Includes_Unkept_Comments
2647
     (Node    : Project_Node_Id;
2648
      In_Tree : Project_Node_Tree_Ref;
2649
      To      : Boolean)
2650
   is
2651
      Declaration : constant Project_Node_Id :=
2652
                      Project_Declaration_Of (Node, In_Tree);
2653
   begin
2654
      In_Tree.Project_Nodes.Table (Declaration).Flag1 := To;
2655
   end Set_Project_File_Includes_Unkept_Comments;
2656
 
2657
   -------------------------
2658
   -- Set_Project_Node_Of --
2659
   -------------------------
2660
 
2661
   procedure Set_Project_Node_Of
2662
     (Node         : Project_Node_Id;
2663
      In_Tree      : Project_Node_Tree_Ref;
2664
      To           : Project_Node_Id;
2665
      Limited_With : Boolean := False)
2666
   is
2667
   begin
2668
      pragma Assert
2669
        (Present (Node)
2670
          and then
2671
            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2672
               or else
2673
             In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference
2674
               or else
2675
             In_Tree.Project_Nodes.Table (Node).Kind = N_Attribute_Reference));
2676
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2677
 
2678
      if In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2679
        and then not Limited_With
2680
      then
2681
         In_Tree.Project_Nodes.Table (Node).Field3 := To;
2682
      end if;
2683
   end Set_Project_Node_Of;
2684
 
2685
   ---------------------------------------
2686
   -- Set_Project_Of_Renamed_Package_Of --
2687
   ---------------------------------------
2688
 
2689
   procedure Set_Project_Of_Renamed_Package_Of
2690
     (Node    : Project_Node_Id;
2691
      In_Tree : Project_Node_Tree_Ref;
2692
      To      : Project_Node_Id)
2693
   is
2694
   begin
2695
      pragma Assert
2696
        (Present (Node)
2697
          and then
2698
            In_Tree.Project_Nodes.Table (Node).Kind = N_Package_Declaration);
2699
      In_Tree.Project_Nodes.Table (Node).Field1 := To;
2700
   end Set_Project_Of_Renamed_Package_Of;
2701
 
2702
   -------------------------
2703
   -- Set_Source_Index_Of --
2704
   -------------------------
2705
 
2706
   procedure Set_Source_Index_Of
2707
     (Node    : Project_Node_Id;
2708
      In_Tree : Project_Node_Tree_Ref;
2709
      To      : Int)
2710
   is
2711
   begin
2712
      pragma Assert
2713
        (Present (Node)
2714
          and then
2715
           (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2716
            or else
2717
            In_Tree.Project_Nodes.Table (Node).Kind =
2718
              N_Attribute_Declaration));
2719
      In_Tree.Project_Nodes.Table (Node).Src_Index := To;
2720
   end Set_Source_Index_Of;
2721
 
2722
   ------------------------
2723
   -- Set_String_Type_Of --
2724
   ------------------------
2725
 
2726
   procedure Set_String_Type_Of
2727
     (Node    : Project_Node_Id;
2728
      In_Tree : Project_Node_Tree_Ref;
2729
      To      : Project_Node_Id)
2730
   is
2731
   begin
2732
      pragma Assert
2733
        (Present (Node)
2734
          and then
2735
           (In_Tree.Project_Nodes.Table (Node).Kind =
2736
              N_Variable_Reference
2737
               or else
2738
            In_Tree.Project_Nodes.Table (Node).Kind =
2739
              N_Typed_Variable_Declaration)
2740
          and then
2741
            In_Tree.Project_Nodes.Table (To).Kind = N_String_Type_Declaration);
2742
 
2743
      if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2744
         In_Tree.Project_Nodes.Table (Node).Field3 := To;
2745
      else
2746
         In_Tree.Project_Nodes.Table (Node).Field2 := To;
2747
      end if;
2748
   end Set_String_Type_Of;
2749
 
2750
   -------------------------
2751
   -- Set_String_Value_Of --
2752
   -------------------------
2753
 
2754
   procedure Set_String_Value_Of
2755
     (Node    : Project_Node_Id;
2756
      In_Tree : Project_Node_Tree_Ref;
2757
      To      : Name_Id)
2758
   is
2759
   begin
2760
      pragma Assert
2761
        (Present (Node)
2762
          and then
2763
            (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2764
               or else
2765
             In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2766
               or else
2767
             In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2768
      In_Tree.Project_Nodes.Table (Node).Value := To;
2769
   end Set_String_Value_Of;
2770
 
2771
   ---------------------
2772
   -- Source_Index_Of --
2773
   ---------------------
2774
 
2775
   function Source_Index_Of
2776
     (Node    : Project_Node_Id;
2777
      In_Tree : Project_Node_Tree_Ref) return Int
2778
   is
2779
   begin
2780
      pragma Assert
2781
        (Present (Node)
2782
          and then
2783
            (In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String
2784
              or else
2785
             In_Tree.Project_Nodes.Table (Node).Kind =
2786
               N_Attribute_Declaration));
2787
      return In_Tree.Project_Nodes.Table (Node).Src_Index;
2788
   end Source_Index_Of;
2789
 
2790
   --------------------
2791
   -- String_Type_Of --
2792
   --------------------
2793
 
2794
   function String_Type_Of
2795
     (Node    : Project_Node_Id;
2796
      In_Tree : Project_Node_Tree_Ref) return Project_Node_Id
2797
   is
2798
   begin
2799
      pragma Assert
2800
        (Present (Node)
2801
          and then
2802
           (In_Tree.Project_Nodes.Table (Node).Kind =
2803
              N_Variable_Reference
2804
               or else
2805
            In_Tree.Project_Nodes.Table (Node).Kind =
2806
              N_Typed_Variable_Declaration));
2807
 
2808
      if In_Tree.Project_Nodes.Table (Node).Kind = N_Variable_Reference then
2809
         return In_Tree.Project_Nodes.Table (Node).Field3;
2810
      else
2811
         return In_Tree.Project_Nodes.Table (Node).Field2;
2812
      end if;
2813
   end String_Type_Of;
2814
 
2815
   ---------------------
2816
   -- String_Value_Of --
2817
   ---------------------
2818
 
2819
   function String_Value_Of
2820
     (Node    : Project_Node_Id;
2821
      In_Tree : Project_Node_Tree_Ref) return Name_Id
2822
   is
2823
   begin
2824
      pragma Assert
2825
        (Present (Node)
2826
          and then
2827
           (In_Tree.Project_Nodes.Table (Node).Kind = N_With_Clause
2828
              or else
2829
            In_Tree.Project_Nodes.Table (Node).Kind = N_Comment
2830
               or else
2831
            In_Tree.Project_Nodes.Table (Node).Kind = N_Literal_String));
2832
      return In_Tree.Project_Nodes.Table (Node).Value;
2833
   end String_Value_Of;
2834
 
2835
   --------------------
2836
   -- Value_Is_Valid --
2837
   --------------------
2838
 
2839
   function Value_Is_Valid
2840
     (For_Typed_Variable : Project_Node_Id;
2841
      In_Tree            : Project_Node_Tree_Ref;
2842
      Value              : Name_Id) return Boolean
2843
   is
2844
   begin
2845
      pragma Assert
2846
        (Present (For_Typed_Variable)
2847
          and then
2848
           (In_Tree.Project_Nodes.Table (For_Typed_Variable).Kind =
2849
                                     N_Typed_Variable_Declaration));
2850
 
2851
      declare
2852
         Current_String : Project_Node_Id :=
2853
                            First_Literal_String
2854
                              (String_Type_Of (For_Typed_Variable, In_Tree),
2855
                               In_Tree);
2856
 
2857
      begin
2858
         while Present (Current_String)
2859
           and then
2860
             String_Value_Of (Current_String, In_Tree) /= Value
2861
         loop
2862
            Current_String :=
2863
              Next_Literal_String (Current_String, In_Tree);
2864
         end loop;
2865
 
2866
         return Present (Current_String);
2867
      end;
2868
 
2869
   end Value_Is_Valid;
2870
 
2871
   -------------------------------
2872
   -- There_Are_Unkept_Comments --
2873
   -------------------------------
2874
 
2875
   function There_Are_Unkept_Comments return Boolean is
2876
   begin
2877
      return Unkept_Comments;
2878
   end There_Are_Unkept_Comments;
2879
 
2880
   --------------------
2881
   -- Create_Project --
2882
   --------------------
2883
 
2884
   function Create_Project
2885
     (In_Tree        : Project_Node_Tree_Ref;
2886
      Name           : Name_Id;
2887
      Full_Path      : Path_Name_Type;
2888
      Is_Config_File : Boolean := False) return Project_Node_Id
2889
   is
2890
      Project   : Project_Node_Id;
2891
      Qualifier : Project_Qualifier := Unspecified;
2892
   begin
2893
      Project := Default_Project_Node (In_Tree, N_Project);
2894
      Set_Name_Of (Project, In_Tree, Name);
2895
      Set_Directory_Of
2896
        (Project, In_Tree,
2897
         Path_Name_Type (Get_Directory (File_Name_Type (Full_Path))));
2898
      Set_Path_Name_Of (Project, In_Tree, Full_Path);
2899
 
2900
      Set_Project_Declaration_Of
2901
        (Project, In_Tree,
2902
         Default_Project_Node (In_Tree, N_Project_Declaration));
2903
 
2904
      if Is_Config_File then
2905
         Qualifier := Configuration;
2906
      end if;
2907
 
2908
      if not Is_Config_File then
2909
         Prj.Tree.Tree_Private_Part.Projects_Htable.Set
2910
           (In_Tree.Projects_HT,
2911
            Name,
2912
            Prj.Tree.Tree_Private_Part.Project_Name_And_Node'
2913
              (Name           => Name,
2914
               Display_Name   => Name,
2915
               Canonical_Path => No_Path,
2916
               Node           => Project,
2917
               Extended       => False,
2918
               Proj_Qualifier => Qualifier));
2919
      end if;
2920
 
2921
      return Project;
2922
   end Create_Project;
2923
 
2924
   ----------------
2925
   -- Add_At_End --
2926
   ----------------
2927
 
2928
   procedure Add_At_End
2929
     (Tree                  : Project_Node_Tree_Ref;
2930
      Parent                : Project_Node_Id;
2931
      Expr                  : Project_Node_Id;
2932
      Add_Before_First_Pkg  : Boolean := False;
2933
      Add_Before_First_Case : Boolean := False)
2934
   is
2935
      Real_Parent          : Project_Node_Id;
2936
      New_Decl, Decl, Next : Project_Node_Id;
2937
      Last, L              : Project_Node_Id;
2938
 
2939
   begin
2940
      if Kind_Of (Expr, Tree) /= N_Declarative_Item then
2941
         New_Decl := Default_Project_Node (Tree, N_Declarative_Item);
2942
         Set_Current_Item_Node (New_Decl, Tree, Expr);
2943
      else
2944
         New_Decl := Expr;
2945
      end if;
2946
 
2947
      if Kind_Of (Parent, Tree) = N_Project then
2948
         Real_Parent := Project_Declaration_Of (Parent, Tree);
2949
      else
2950
         Real_Parent := Parent;
2951
      end if;
2952
 
2953
      Decl := First_Declarative_Item_Of (Real_Parent, Tree);
2954
 
2955
      if Decl = Empty_Node then
2956
         Set_First_Declarative_Item_Of (Real_Parent, Tree, New_Decl);
2957
      else
2958
         loop
2959
            Next := Next_Declarative_Item (Decl, Tree);
2960
            exit when Next = Empty_Node
2961
              or else
2962
               (Add_Before_First_Pkg
2963
                 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2964
                                                        N_Package_Declaration)
2965
              or else
2966
               (Add_Before_First_Case
2967
                 and then Kind_Of (Current_Item_Node (Next, Tree), Tree) =
2968
                                                        N_Case_Construction);
2969
            Decl := Next;
2970
         end loop;
2971
 
2972
         --  In case Expr is in fact a range of declarative items
2973
 
2974
         Last := New_Decl;
2975
         loop
2976
            L := Next_Declarative_Item (Last, Tree);
2977
            exit when L = Empty_Node;
2978
            Last := L;
2979
         end loop;
2980
 
2981
         --  In case Expr is in fact a range of declarative items
2982
 
2983
         Last := New_Decl;
2984
         loop
2985
            L := Next_Declarative_Item (Last, Tree);
2986
            exit when L = Empty_Node;
2987
            Last := L;
2988
         end loop;
2989
 
2990
         Set_Next_Declarative_Item (Last, Tree, Next);
2991
         Set_Next_Declarative_Item (Decl, Tree, New_Decl);
2992
      end if;
2993
   end Add_At_End;
2994
 
2995
   ---------------------------
2996
   -- Create_Literal_String --
2997
   ---------------------------
2998
 
2999
   function Create_Literal_String
3000
     (Str  : Namet.Name_Id;
3001
      Tree : Project_Node_Tree_Ref) return Project_Node_Id
3002
   is
3003
      Node : Project_Node_Id;
3004
   begin
3005
      Node := Default_Project_Node (Tree, N_Literal_String, Prj.Single);
3006
      Set_Next_Literal_String (Node, Tree, Empty_Node);
3007
      Set_String_Value_Of (Node, Tree, Str);
3008
      return Node;
3009
   end Create_Literal_String;
3010
 
3011
   ---------------------------
3012
   -- Enclose_In_Expression --
3013
   ---------------------------
3014
 
3015
   function Enclose_In_Expression
3016
     (Node : Project_Node_Id;
3017
      Tree : Project_Node_Tree_Ref) return Project_Node_Id
3018
   is
3019
      Expr : Project_Node_Id;
3020
   begin
3021
      if Kind_Of (Node, Tree) /= N_Expression then
3022
         Expr := Default_Project_Node (Tree, N_Expression, Single);
3023
         Set_First_Term
3024
           (Expr, Tree, Default_Project_Node (Tree, N_Term, Single));
3025
         Set_Current_Term (First_Term (Expr, Tree), Tree, Node);
3026
         return Expr;
3027
      else
3028
         return Node;
3029
      end if;
3030
   end Enclose_In_Expression;
3031
 
3032
   --------------------
3033
   -- Create_Package --
3034
   --------------------
3035
 
3036
   function Create_Package
3037
     (Tree    : Project_Node_Tree_Ref;
3038
      Project : Project_Node_Id;
3039
      Pkg     : String) return Project_Node_Id
3040
   is
3041
      Pack : Project_Node_Id;
3042
      N    : Name_Id;
3043
 
3044
   begin
3045
      Name_Len := Pkg'Length;
3046
      Name_Buffer (1 .. Name_Len) := Pkg;
3047
      N := Name_Find;
3048
 
3049
      --  Check if the package already exists
3050
 
3051
      Pack := First_Package_Of (Project, Tree);
3052
      while Pack /= Empty_Node loop
3053
         if Prj.Tree.Name_Of (Pack, Tree) = N then
3054
            return Pack;
3055
         end if;
3056
 
3057
         Pack := Next_Package_In_Project (Pack, Tree);
3058
      end loop;
3059
 
3060
      --  Create the package and add it to the declarative item
3061
 
3062
      Pack := Default_Project_Node (Tree, N_Package_Declaration);
3063
      Set_Name_Of (Pack, Tree, N);
3064
 
3065
      --  Find the correct package id to use
3066
 
3067
      Set_Package_Id_Of (Pack, Tree, Package_Node_Id_Of (N));
3068
 
3069
      --  Add it to the list of packages
3070
 
3071
      Set_Next_Package_In_Project
3072
        (Pack, Tree, First_Package_Of (Project, Tree));
3073
      Set_First_Package_Of (Project, Tree, Pack);
3074
 
3075
      Add_At_End (Tree, Project_Declaration_Of (Project, Tree), Pack);
3076
 
3077
      return Pack;
3078
   end Create_Package;
3079
 
3080
   ----------------------
3081
   -- Create_Attribute --
3082
   ----------------------
3083
 
3084
   function Create_Attribute
3085
     (Tree       : Project_Node_Tree_Ref;
3086
      Prj_Or_Pkg : Project_Node_Id;
3087
      Name       : Name_Id;
3088
      Index_Name : Name_Id       := No_Name;
3089
      Kind       : Variable_Kind := List;
3090
      At_Index   : Integer       := 0;
3091
      Value      : Project_Node_Id := Empty_Node) return Project_Node_Id
3092
   is
3093
      Node : constant Project_Node_Id :=
3094
               Default_Project_Node (Tree, N_Attribute_Declaration, Kind);
3095
 
3096
      Case_Insensitive : Boolean;
3097
 
3098
      Pkg      : Package_Node_Id;
3099
      Start_At : Attribute_Node_Id;
3100
      Expr     : Project_Node_Id;
3101
 
3102
   begin
3103
      Set_Name_Of (Node, Tree, Name);
3104
 
3105
      if Index_Name /= No_Name then
3106
         Set_Associative_Array_Index_Of (Node, Tree, Index_Name);
3107
      end if;
3108
 
3109
      if Prj_Or_Pkg /= Empty_Node then
3110
         Add_At_End (Tree, Prj_Or_Pkg, Node);
3111
      end if;
3112
 
3113
      --  Find out the case sensitivity of the attribute
3114
 
3115
      if Prj_Or_Pkg /= Empty_Node
3116
        and then Kind_Of (Prj_Or_Pkg, Tree) = N_Package_Declaration
3117
      then
3118
         Pkg      := Prj.Attr.Package_Node_Id_Of (Name_Of (Prj_Or_Pkg, Tree));
3119
         Start_At := First_Attribute_Of (Pkg);
3120
      else
3121
         Start_At := Attribute_First;
3122
      end if;
3123
 
3124
      Start_At := Attribute_Node_Id_Of (Name, Start_At);
3125
      Case_Insensitive :=
3126
        Attribute_Kind_Of (Start_At) = Case_Insensitive_Associative_Array;
3127
      Tree.Project_Nodes.Table (Node).Flag1 := Case_Insensitive;
3128
 
3129
      if At_Index /= 0 then
3130
         if Attribute_Kind_Of (Start_At) =
3131
              Optional_Index_Associative_Array
3132
           or else Attribute_Kind_Of (Start_At) =
3133
              Optional_Index_Case_Insensitive_Associative_Array
3134
         then
3135
            --  Results in:   for Name ("index" at index) use "value";
3136
            --  This is currently only used for executables.
3137
 
3138
            Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
3139
 
3140
         else
3141
            --  Results in:   for Name ("index") use "value" at index;
3142
 
3143
            --  ??? This limitation makes no sense, we should be able to
3144
            --  set the source index on an expression.
3145
 
3146
            pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
3147
            Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
3148
         end if;
3149
      end if;
3150
 
3151
      if Value /= Empty_Node then
3152
         Expr := Enclose_In_Expression (Value, Tree);
3153
         Set_Expression_Of (Node, Tree, Expr);
3154
      end if;
3155
 
3156
      return Node;
3157
   end Create_Attribute;
3158
 
3159
end Prj.Tree;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.