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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-rbtgbk.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT LIBRARY COMPONENTS                          --
4
--                                                                          --
5
--            ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_KEYS           --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2004-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.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- This unit was originally developed by Matthew J Heaney.                  --
28
------------------------------------------------------------------------------
29
 
30
package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys is
31
 
32
   package Ops renames Tree_Operations;
33
 
34
   -------------
35
   -- Ceiling --
36
   -------------
37
 
38
   --  AKA Lower_Bound
39
 
40
   function Ceiling
41
     (Tree : Tree_Type'Class;
42
      Key  : Key_Type) return Count_Type
43
   is
44
      Y : Count_Type;
45
      X : Count_Type;
46
      N : Nodes_Type renames Tree.Nodes;
47
 
48
   begin
49
      Y := 0;
50
 
51
      X := Tree.Root;
52
      while X /= 0 loop
53
         if Is_Greater_Key_Node (Key, N (X)) then
54
            X := Ops.Right (N (X));
55
         else
56
            Y := X;
57
            X := Ops.Left (N (X));
58
         end if;
59
      end loop;
60
 
61
      return Y;
62
   end Ceiling;
63
 
64
   ----------
65
   -- Find --
66
   ----------
67
 
68
   function Find
69
     (Tree : Tree_Type'Class;
70
      Key  : Key_Type) return Count_Type
71
   is
72
      Y : Count_Type;
73
      X : Count_Type;
74
      N : Nodes_Type renames Tree.Nodes;
75
 
76
   begin
77
      Y := 0;
78
 
79
      X := Tree.Root;
80
      while X /= 0 loop
81
         if Is_Greater_Key_Node (Key, N (X)) then
82
            X := Ops.Right (N (X));
83
         else
84
            Y := X;
85
            X := Ops.Left (N (X));
86
         end if;
87
      end loop;
88
 
89
      if Y = 0 then
90
         return 0;
91
      end if;
92
 
93
      if Is_Less_Key_Node (Key, N (Y)) then
94
         return 0;
95
      end if;
96
 
97
      return Y;
98
   end Find;
99
 
100
   -----------
101
   -- Floor --
102
   -----------
103
 
104
   function Floor
105
     (Tree : Tree_Type'Class;
106
      Key  : Key_Type) return Count_Type
107
   is
108
      Y : Count_Type;
109
      X : Count_Type;
110
      N : Nodes_Type renames Tree.Nodes;
111
 
112
   begin
113
      Y := 0;
114
 
115
      X := Tree.Root;
116
      while X /= 0 loop
117
         if Is_Less_Key_Node (Key, N (X)) then
118
            X := Ops.Left (N (X));
119
         else
120
            Y := X;
121
            X := Ops.Right (N (X));
122
         end if;
123
      end loop;
124
 
125
      return Y;
126
   end Floor;
127
 
128
   --------------------------------
129
   -- Generic_Conditional_Insert --
130
   --------------------------------
131
 
132
   procedure Generic_Conditional_Insert
133
     (Tree     : in out Tree_Type'Class;
134
      Key      : Key_Type;
135
      Node     : out Count_Type;
136
      Inserted : out Boolean)
137
   is
138
      Y : Count_Type;
139
      X : Count_Type;
140
      N : Nodes_Type renames Tree.Nodes;
141
 
142
   begin
143
      --  This is a "conditional" insertion, meaning that the insertion request
144
      --  can "fail" in the sense that no new node is created. If the Key is
145
      --  equivalent to an existing node, then we return the existing node and
146
      --  Inserted is set to False. Otherwise, we allocate a new node (via
147
      --  Insert_Post) and Inserted is set to True.
148
 
149
      --  Note that we are testing for equivalence here, not equality. Key must
150
      --  be strictly less than its next neighbor, and strictly greater than
151
      --  its previous neighbor, in order for the conditional insertion to
152
      --  succeed.
153
 
154
      --  We search the tree to find the nearest neighbor of Key, which is
155
      --  either the smallest node greater than Key (Inserted is True), or the
156
      --  largest node less or equivalent to Key (Inserted is False).
157
 
158
      Y := 0;
159
      X := Tree.Root;
160
      Inserted := True;
161
      while X /= 0 loop
162
         Y := X;
163
         Inserted := Is_Less_Key_Node (Key, N (X));
164
         X := (if Inserted then Ops.Left (N (X)) else Ops.Right (N (X)));
165
      end loop;
166
 
167
      if Inserted then
168
 
169
         --  Either Tree is empty, or Key is less than Y. If Y is the first
170
         --  node in the tree, then there are no other nodes that we need to
171
         --  search for, and we insert a new node into the tree.
172
 
173
         if Y = Tree.First then
174
            Insert_Post (Tree, Y, True, Node);
175
            return;
176
         end if;
177
 
178
         --  Y is the next nearest-neighbor of Key. We know that Key is not
179
         --  equivalent to Y (because Key is strictly less than Y), so we move
180
         --  to the previous node, the nearest-neighbor just smaller or
181
         --  equivalent to Key.
182
 
183
         Node := Ops.Previous (Tree, Y);
184
 
185
      else
186
         --  Y is the previous nearest-neighbor of Key. We know that Key is not
187
         --  less than Y, which means either that Key is equivalent to Y, or
188
         --  greater than Y.
189
 
190
         Node := Y;
191
      end if;
192
 
193
      --  Key is equivalent to or greater than Node. We must resolve which is
194
      --  the case, to determine whether the conditional insertion succeeds.
195
 
196
      if Is_Greater_Key_Node (Key, N (Node)) then
197
 
198
         --  Key is strictly greater than Node, which means that Key is not
199
         --  equivalent to Node. In this case, the insertion succeeds, and we
200
         --  insert a new node into the tree.
201
 
202
         Insert_Post (Tree, Y, Inserted, Node);
203
         Inserted := True;
204
         return;
205
      end if;
206
 
207
      --  Key is equivalent to Node. This is a conditional insertion, so we do
208
      --  not insert a new node in this case. We return the existing node and
209
      --  report that no insertion has occurred.
210
 
211
      Inserted := False;
212
   end Generic_Conditional_Insert;
213
 
214
   ------------------------------------------
215
   -- Generic_Conditional_Insert_With_Hint --
216
   ------------------------------------------
217
 
218
   procedure Generic_Conditional_Insert_With_Hint
219
     (Tree      : in out Tree_Type'Class;
220
      Position  : Count_Type;
221
      Key       : Key_Type;
222
      Node      : out Count_Type;
223
      Inserted  : out Boolean)
224
   is
225
      N : Nodes_Type renames Tree.Nodes;
226
 
227
   begin
228
      --  The purpose of a hint is to avoid a search from the root of
229
      --  tree. If we have it hint it means we only need to traverse the
230
      --  subtree rooted at the hint to find the nearest neighbor. Note
231
      --  that finding the neighbor means merely walking the tree; this
232
      --  is not a search and the only comparisons that occur are with
233
      --  the hint and its neighbor.
234
 
235
      --  If Position is 0, this is interpreted to mean that Key is
236
      --  large relative to the nodes in the tree. If the tree is empty,
237
      --  or Key is greater than the last node in the tree, then we're
238
      --  done; otherwise the hint was "wrong" and we must search.
239
 
240
      if Position = 0 then  -- largest
241
         if Tree.Last = 0
242
           or else Is_Greater_Key_Node (Key, N (Tree.Last))
243
         then
244
            Insert_Post (Tree, Tree.Last, False, Node);
245
            Inserted := True;
246
         else
247
            Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
248
         end if;
249
 
250
         return;
251
      end if;
252
 
253
      pragma Assert (Tree.Length > 0);
254
 
255
      --  A hint can either name the node that immediately follows Key,
256
      --  or immediately precedes Key. We first test whether Key is
257
      --  less than the hint, and if so we compare Key to the node that
258
      --  precedes the hint. If Key is both less than the hint and
259
      --  greater than the hint's preceding neighbor, then we're done;
260
      --  otherwise we must search.
261
 
262
      --  Note also that a hint can either be an anterior node or a leaf
263
      --  node. A new node is always inserted at the bottom of the tree
264
      --  (at least prior to rebalancing), becoming the new left or
265
      --  right child of leaf node (which prior to the insertion must
266
      --  necessarily be null, since this is a leaf). If the hint names
267
      --  an anterior node then its neighbor must be a leaf, and so
268
      --  (here) we insert after the neighbor. If the hint names a leaf
269
      --  then its neighbor must be anterior and so we insert before the
270
      --  hint.
271
 
272
      if Is_Less_Key_Node (Key, N (Position)) then
273
         declare
274
            Before : constant Count_Type := Ops.Previous (Tree, Position);
275
 
276
         begin
277
            if Before = 0 then
278
               Insert_Post (Tree, Tree.First, True, Node);
279
               Inserted := True;
280
 
281
            elsif Is_Greater_Key_Node (Key, N (Before)) then
282
               if Ops.Right (N (Before)) = 0 then
283
                  Insert_Post (Tree, Before, False, Node);
284
               else
285
                  Insert_Post (Tree, Position, True, Node);
286
               end if;
287
 
288
               Inserted := True;
289
 
290
            else
291
               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
292
            end if;
293
         end;
294
 
295
         return;
296
      end if;
297
 
298
      --  We know that Key isn't less than the hint so we try again,
299
      --  this time to see if it's greater than the hint. If so we
300
      --  compare Key to the node that follows the hint. If Key is both
301
      --  greater than the hint and less than the hint's next neighbor,
302
      --  then we're done; otherwise we must search.
303
 
304
      if Is_Greater_Key_Node (Key, N (Position)) then
305
         declare
306
            After : constant Count_Type := Ops.Next (Tree, Position);
307
 
308
         begin
309
            if After = 0 then
310
               Insert_Post (Tree, Tree.Last, False, Node);
311
               Inserted := True;
312
 
313
            elsif Is_Less_Key_Node (Key, N (After)) then
314
               if Ops.Right (N (Position)) = 0 then
315
                  Insert_Post (Tree, Position, False, Node);
316
               else
317
                  Insert_Post (Tree, After, True, Node);
318
               end if;
319
 
320
               Inserted := True;
321
 
322
            else
323
               Conditional_Insert_Sans_Hint (Tree, Key, Node, Inserted);
324
            end if;
325
         end;
326
 
327
         return;
328
      end if;
329
 
330
      --  We know that Key is neither less than the hint nor greater
331
      --  than the hint, and that's the definition of equivalence.
332
      --  There's nothing else we need to do, since a search would just
333
      --  reach the same conclusion.
334
 
335
      Node := Position;
336
      Inserted := False;
337
   end Generic_Conditional_Insert_With_Hint;
338
 
339
   -------------------------
340
   -- Generic_Insert_Post --
341
   -------------------------
342
 
343
   procedure Generic_Insert_Post
344
     (Tree   : in out Tree_Type'Class;
345
      Y      : Count_Type;
346
      Before : Boolean;
347
      Z      : out Count_Type)
348
   is
349
      N : Nodes_Type renames Tree.Nodes;
350
 
351
   begin
352
      if Tree.Length >= Tree.Capacity then
353
         raise Capacity_Error with "not enough capacity to insert new item";
354
      end if;
355
 
356
      if Tree.Busy > 0 then
357
         raise Program_Error with
358
           "attempt to tamper with cursors (container is busy)";
359
      end if;
360
 
361
      Z := New_Node;
362
      pragma Assert (Z /= 0);
363
 
364
      if Y = 0 then
365
         pragma Assert (Tree.Length = 0);
366
         pragma Assert (Tree.Root = 0);
367
         pragma Assert (Tree.First = 0);
368
         pragma Assert (Tree.Last = 0);
369
 
370
         Tree.Root := Z;
371
         Tree.First := Z;
372
         Tree.Last := Z;
373
 
374
      elsif Before then
375
         pragma Assert (Ops.Left (N (Y)) = 0);
376
 
377
         Ops.Set_Left (N (Y), Z);
378
 
379
         if Y = Tree.First then
380
            Tree.First := Z;
381
         end if;
382
 
383
      else
384
         pragma Assert (Ops.Right (N (Y)) = 0);
385
 
386
         Ops.Set_Right (N (Y), Z);
387
 
388
         if Y = Tree.Last then
389
            Tree.Last := Z;
390
         end if;
391
      end if;
392
 
393
      Ops.Set_Color (N (Z), Red);
394
      Ops.Set_Parent (N (Z), Y);
395
      Ops.Rebalance_For_Insert (Tree, Z);
396
      Tree.Length := Tree.Length + 1;
397
   end Generic_Insert_Post;
398
 
399
   -----------------------
400
   -- Generic_Iteration --
401
   -----------------------
402
 
403
   procedure Generic_Iteration
404
     (Tree : Tree_Type'Class;
405
      Key  : Key_Type)
406
   is
407
      procedure Iterate (Index : Count_Type);
408
 
409
      -------------
410
      -- Iterate --
411
      -------------
412
 
413
      procedure Iterate (Index : Count_Type) is
414
         J : Count_Type;
415
         N : Nodes_Type renames Tree.Nodes;
416
 
417
      begin
418
         J := Index;
419
         while J /= 0 loop
420
            if Is_Less_Key_Node (Key, N (J)) then
421
               J := Ops.Left (N (J));
422
            elsif Is_Greater_Key_Node (Key, N (J)) then
423
               J := Ops.Right (N (J));
424
            else
425
               Iterate (Ops.Left (N (J)));
426
               Process (J);
427
               J := Ops.Right (N (J));
428
            end if;
429
         end loop;
430
      end Iterate;
431
 
432
   --  Start of processing for Generic_Iteration
433
 
434
   begin
435
      Iterate (Tree.Root);
436
   end Generic_Iteration;
437
 
438
   -------------------------------
439
   -- Generic_Reverse_Iteration --
440
   -------------------------------
441
 
442
   procedure Generic_Reverse_Iteration
443
     (Tree : Tree_Type'Class;
444
      Key  : Key_Type)
445
   is
446
      procedure Iterate (Index : Count_Type);
447
 
448
      -------------
449
      -- Iterate --
450
      -------------
451
 
452
      procedure Iterate (Index : Count_Type) is
453
         J : Count_Type;
454
         N : Nodes_Type renames Tree.Nodes;
455
 
456
      begin
457
         J := Index;
458
         while J /= 0 loop
459
            if Is_Less_Key_Node (Key, N (J)) then
460
               J := Ops.Left (N (J));
461
            elsif Is_Greater_Key_Node (Key, N (J)) then
462
               J := Ops.Right (N (J));
463
            else
464
               Iterate (Ops.Right (N (J)));
465
               Process (J);
466
               J := Ops.Left (N (J));
467
            end if;
468
         end loop;
469
      end Iterate;
470
 
471
   --  Start of processing for Generic_Reverse_Iteration
472
 
473
   begin
474
      Iterate (Tree.Root);
475
   end Generic_Reverse_Iteration;
476
 
477
   ----------------------------------
478
   -- Generic_Unconditional_Insert --
479
   ----------------------------------
480
 
481
   procedure Generic_Unconditional_Insert
482
     (Tree : in out Tree_Type'Class;
483
      Key  : Key_Type;
484
      Node : out Count_Type)
485
   is
486
      Y : Count_Type;
487
      X : Count_Type;
488
      N : Nodes_Type renames Tree.Nodes;
489
 
490
      Before : Boolean;
491
 
492
   begin
493
      Y := 0;
494
      Before := False;
495
 
496
      X := Tree.Root;
497
      while X /= 0 loop
498
         Y := X;
499
         Before := Is_Less_Key_Node (Key, N (X));
500
         X := (if Before then Ops.Left (N (X)) else Ops.Right (N (X)));
501
      end loop;
502
 
503
      Insert_Post (Tree, Y, Before, Node);
504
   end Generic_Unconditional_Insert;
505
 
506
   --------------------------------------------
507
   -- Generic_Unconditional_Insert_With_Hint --
508
   --------------------------------------------
509
 
510
   procedure Generic_Unconditional_Insert_With_Hint
511
     (Tree : in out Tree_Type'Class;
512
      Hint : Count_Type;
513
      Key  : Key_Type;
514
      Node : out Count_Type)
515
   is
516
      N : Nodes_Type renames Tree.Nodes;
517
 
518
   begin
519
      --  There are fewer constraints for an unconditional insertion
520
      --  than for a conditional insertion, since we allow duplicate
521
      --  keys. So instead of having to check (say) whether Key is
522
      --  (strictly) greater than the hint's previous neighbor, here we
523
      --  allow Key to be equal to or greater than the previous node.
524
 
525
      --  There is the issue of what to do if Key is equivalent to the
526
      --  hint. Does the new node get inserted before or after the hint?
527
      --  We decide that it gets inserted after the hint, reasoning that
528
      --  this is consistent with behavior for non-hint insertion, which
529
      --  inserts a new node after existing nodes with equivalent keys.
530
 
531
      --  First we check whether the hint is null, which is interpreted
532
      --  to mean that Key is large relative to existing nodes.
533
      --  Following our rule above, if Key is equal to or greater than
534
      --  the last node, then we insert the new node immediately after
535
      --  last. (We don't have an operation for testing whether a key is
536
      --  "equal to or greater than" a node, so we must say instead "not
537
      --  less than", which is equivalent.)
538
 
539
      if Hint = 0 then  -- largest
540
         if Tree.Last = 0 then
541
            Insert_Post (Tree, 0, False, Node);
542
         elsif Is_Less_Key_Node (Key, N (Tree.Last)) then
543
            Unconditional_Insert_Sans_Hint (Tree, Key, Node);
544
         else
545
            Insert_Post (Tree, Tree.Last, False, Node);
546
         end if;
547
 
548
         return;
549
      end if;
550
 
551
      pragma Assert (Tree.Length > 0);
552
 
553
      --  We decide here whether to insert the new node prior to the
554
      --  hint. Key could be equivalent to the hint, so in theory we
555
      --  could write the following test as "not greater than" (same as
556
      --  "less than or equal to"). If Key were equivalent to the hint,
557
      --  that would mean that the new node gets inserted before an
558
      --  equivalent node. That wouldn't break any container invariants,
559
      --  but our rule above says that new nodes always get inserted
560
      --  after equivalent nodes. So here we test whether Key is both
561
      --  less than the hint and equal to or greater than the hint's
562
      --  previous neighbor, and if so insert it before the hint.
563
 
564
      if Is_Less_Key_Node (Key, N (Hint)) then
565
         declare
566
            Before : constant Count_Type := Ops.Previous (Tree, Hint);
567
         begin
568
            if Before = 0 then
569
               Insert_Post (Tree, Hint, True, Node);
570
            elsif Is_Less_Key_Node (Key, N (Before)) then
571
               Unconditional_Insert_Sans_Hint (Tree, Key, Node);
572
            elsif Ops.Right (N (Before)) = 0 then
573
               Insert_Post (Tree, Before, False, Node);
574
            else
575
               Insert_Post (Tree, Hint, True, Node);
576
            end if;
577
         end;
578
 
579
         return;
580
      end if;
581
 
582
      --  We know that Key isn't less than the hint, so it must be equal
583
      --  or greater. So we just test whether Key is less than or equal
584
      --  to (same as "not greater than") the hint's next neighbor, and
585
      --  if so insert it after the hint.
586
 
587
      declare
588
         After : constant Count_Type := Ops.Next (Tree, Hint);
589
      begin
590
         if After = 0 then
591
            Insert_Post (Tree, Hint, False, Node);
592
         elsif Is_Greater_Key_Node (Key, N (After)) then
593
            Unconditional_Insert_Sans_Hint (Tree, Key, Node);
594
         elsif Ops.Right (N (Hint)) = 0 then
595
            Insert_Post (Tree, Hint, False, Node);
596
         else
597
            Insert_Post (Tree, After, True, Node);
598
         end if;
599
      end;
600
   end Generic_Unconditional_Insert_With_Hint;
601
 
602
   -----------------
603
   -- Upper_Bound --
604
   -----------------
605
 
606
   function Upper_Bound
607
     (Tree : Tree_Type'Class;
608
      Key  : Key_Type) return Count_Type
609
   is
610
      Y : Count_Type;
611
      X : Count_Type;
612
      N : Nodes_Type renames Tree.Nodes;
613
 
614
   begin
615
      Y := 0;
616
 
617
      X := Tree.Root;
618
      while X /= 0 loop
619
         if Is_Less_Key_Node (Key, N (X)) then
620
            Y := X;
621
            X := Ops.Left (N (X));
622
         else
623
            X := Ops.Right (N (X));
624
         end if;
625
      end loop;
626
 
627
      return Y;
628
   end Upper_Bound;
629
 
630
end Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys;

powered by: WebSVN 2.1.0

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