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

Subversion Repositories openrisc

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

powered by: WebSVN 2.1.0

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