1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S . --
6 -- G E N E R I C _ K E Y S --
10 -- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
12 -- This specification is derived from the Ada Reference Manual for use with --
13 -- GNAT. The copyright notice above, and the license provisions that follow --
14 -- apply solely to the contents of the part following the private keyword. --
16 -- GNAT is free software; you can redistribute it and/or modify it under --
17 -- terms of the GNU General Public License as published by the Free Soft- --
18 -- ware Foundation; either version 2, or (at your option) any later ver- --
19 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
20 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
21 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
22 -- for more details. You should have received a copy of the GNU General --
23 -- Public License distributed with GNAT; see file COPYING. If not, write --
24 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
25 -- Boston, MA 02110-1301, USA. --
27 -- As a special exception, if other files instantiate generics from this --
28 -- unit, or you link this unit with other files to produce an executable, --
29 -- this unit does not by itself cause the resulting executable to be --
30 -- covered by the GNU General Public License. This exception does not --
31 -- however invalidate any other reasons why the executable file might be --
32 -- covered by the GNU Public License. --
34 -- This unit was originally developed by Matthew J Heaney. --
35 ------------------------------------------------------------------------------
37 package body Ada
.Containers
.Red_Black_Trees
.Generic_Keys
is
39 package Ops
renames Tree_Operations
;
47 function Ceiling
(Tree
: Tree_Type
; Key
: Key_Type
) return Node_Access
is
49 X
: Node_Access
:= Tree
.Root
;
53 if Is_Greater_Key_Node
(Key
, X
) then
68 function Find
(Tree
: Tree_Type
; Key
: Key_Type
) return Node_Access
is
70 X
: Node_Access
:= Tree
.Root
;
74 if Is_Greater_Key_Node
(Key
, X
) then
86 if Is_Less_Key_Node
(Key
, Y
) then
97 function Floor
(Tree
: Tree_Type
; Key
: Key_Type
) return Node_Access
is
99 X
: Node_Access
:= Tree
.Root
;
103 if Is_Less_Key_Node
(Key
, X
) then
114 --------------------------------
115 -- Generic_Conditional_Insert --
116 --------------------------------
118 procedure Generic_Conditional_Insert
119 (Tree
: in out Tree_Type
;
121 Node
: out Node_Access
;
122 Success
: out Boolean)
124 Y
: Node_Access
:= null;
125 X
: Node_Access
:= Tree
.Root
;
131 Success
:= Is_Less_Key_Node
(Key
, X
);
143 if Node
= Tree
.First
then
144 Insert_Post
(Tree
, X
, Y
, Key
, Node
);
148 Node
:= Ops
.Previous
(Node
);
151 if Is_Greater_Key_Node
(Key
, Node
) then
152 Insert_Post
(Tree
, X
, Y
, Key
, Node
);
158 end Generic_Conditional_Insert
;
160 ------------------------------------------
161 -- Generic_Conditional_Insert_With_Hint --
162 ------------------------------------------
164 procedure Generic_Conditional_Insert_With_Hint
165 (Tree
: in out Tree_Type
;
166 Position
: Node_Access
;
168 Node
: out Node_Access
;
169 Success
: out Boolean)
172 if Position
= null then -- largest
174 and then Is_Greater_Key_Node
(Key
, Tree
.Last
)
176 Insert_Post
(Tree
, null, Tree
.Last
, Key
, Node
);
179 Conditional_Insert_Sans_Hint
(Tree
, Key
, Node
, Success
);
185 pragma Assert
(Tree
.Length
> 0);
187 if Is_Less_Key_Node
(Key
, Position
) then
188 if Position
= Tree
.First
then
189 Insert_Post
(Tree
, Position
, Position
, Key
, Node
);
195 Before
: constant Node_Access
:= Ops
.Previous
(Position
);
198 if Is_Greater_Key_Node
(Key
, Before
) then
199 if Ops
.Right
(Before
) = null then
200 Insert_Post
(Tree
, null, Before
, Key
, Node
);
202 Insert_Post
(Tree
, Position
, Position
, Key
, Node
);
208 Conditional_Insert_Sans_Hint
(Tree
, Key
, Node
, Success
);
215 if Is_Greater_Key_Node
(Key
, Position
) then
216 if Position
= Tree
.Last
then
217 Insert_Post
(Tree
, null, Tree
.Last
, Key
, Node
);
223 After
: constant Node_Access
:= Ops
.Next
(Position
);
226 if Is_Less_Key_Node
(Key
, After
) then
227 if Ops
.Right
(Position
) = null then
228 Insert_Post
(Tree
, null, Position
, Key
, Node
);
230 Insert_Post
(Tree
, After
, After
, Key
, Node
);
236 Conditional_Insert_Sans_Hint
(Tree
, Key
, Node
, Success
);
245 end Generic_Conditional_Insert_With_Hint
;
247 -------------------------
248 -- Generic_Insert_Post --
249 -------------------------
251 procedure Generic_Insert_Post
252 (Tree
: in out Tree_Type
;
257 subtype Length_Subtype
is Count_Type
range 0 .. Count_Type
'Last - 1;
259 New_Length
: constant Count_Type
:= Length_Subtype
'(Tree.Length) + 1;
262 if Tree.Busy > 0 then
268 or else Is_Less_Key_Node (Key, Y)
270 pragma Assert (Y = null
271 or else Ops.Left (Y) = null);
273 -- Delay allocation as long as we can, in order to defend
274 -- against exceptions propagated by relational operators.
278 pragma Assert (Z /= null);
279 pragma Assert (Ops.Color (Z) = Red);
282 pragma Assert (Tree.Length = 0);
283 pragma Assert (Tree.Root = null);
284 pragma Assert (Tree.First = null);
285 pragma Assert (Tree.Last = null);
294 if Y = Tree.First then
300 pragma Assert (Ops.Right (Y) = null);
302 -- Delay allocation as long as we can, in order to defend
303 -- against exceptions propagated by relational operators.
307 pragma Assert (Z /= null);
308 pragma Assert (Ops.Color (Z) = Red);
310 Ops.Set_Right (Y, Z);
312 if Y = Tree.Last then
317 Ops.Set_Parent (Z, Y);
318 Ops.Rebalance_For_Insert (Tree, Z);
319 Tree.Length := New_Length;
320 end Generic_Insert_Post;
322 -----------------------
323 -- Generic_Iteration --
324 -----------------------
326 procedure Generic_Iteration
330 procedure Iterate (Node : Node_Access);
336 procedure Iterate (Node : Node_Access) is
337 N : Node_Access := Node;
340 if Is_Less_Key_Node (Key, N) then
342 elsif Is_Greater_Key_Node (Key, N) then
345 Iterate (Ops.Left (N));
352 -- Start of processing for Generic_Iteration
356 end Generic_Iteration;
358 -------------------------------
359 -- Generic_Reverse_Iteration --
360 -------------------------------
362 procedure Generic_Reverse_Iteration
366 procedure Iterate (Node : Node_Access);
372 procedure Iterate (Node : Node_Access) is
373 N : Node_Access := Node;
376 if Is_Less_Key_Node (Key, N) then
378 elsif Is_Greater_Key_Node (Key, N) then
381 Iterate (Ops.Right (N));
388 -- Start of processing for Generic_Reverse_Iteration
392 end Generic_Reverse_Iteration;
394 ----------------------------------
395 -- Generic_Unconditional_Insert --
396 ----------------------------------
398 procedure Generic_Unconditional_Insert
399 (Tree : in out Tree_Type;
401 Node : out Node_Access)
403 Y : Node_Access := null;
404 X : Node_Access := Tree.Root;
410 if Is_Less_Key_Node (Key, X) then
417 Insert_Post (Tree, X, Y, Key, Node);
418 end Generic_Unconditional_Insert;
420 --------------------------------------------
421 -- Generic_Unconditional_Insert_With_Hint --
422 --------------------------------------------
424 procedure Generic_Unconditional_Insert_With_Hint
425 (Tree : in out Tree_Type;
428 Node : out Node_Access)
430 -- TODO: verify this algorithm. It was (quickly) adapted it from the
431 -- same algorithm for conditional_with_hint. It may be that the test
432 -- Key > Hint should be something like a Key >= Hint, to handle the
433 -- case when Hint is The Last Item of A (Contiguous) sequence of
434 -- Equivalent Items. (The Key < Hint Test is probably OK. It is not
435 -- clear that you can use Key <= Hint, since new items are always
436 -- inserted last in the sequence of equivalent items.) ???
439 if Hint = null then -- largest
441 and then Is_Greater_Key_Node (Key, Tree.Last)
443 Insert_Post (Tree, null, Tree.Last, Key, Node);
445 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
451 pragma Assert (Tree.Length > 0);
453 if Is_Less_Key_Node (Key, Hint) then
454 if Hint = Tree.First then
455 Insert_Post (Tree, Hint, Hint, Key, Node);
460 Before : constant Node_Access := Ops.Previous (Hint);
462 if Is_Greater_Key_Node (Key, Before) then
463 if Ops.Right (Before) = null then
464 Insert_Post (Tree, null, Before, Key, Node);
466 Insert_Post (Tree, Hint, Hint, Key, Node);
469 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
476 if Is_Greater_Key_Node (Key, Hint) then
477 if Hint = Tree.Last then
478 Insert_Post (Tree, null, Tree.Last, Key, Node);
483 After : constant Node_Access := Ops.Next (Hint);
485 if Is_Less_Key_Node (Key, After) then
486 if Ops.Right (Hint) = null then
487 Insert_Post (Tree, null, Hint, Key, Node);
489 Insert_Post (Tree, After, After, Key, Node);
492 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
499 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
500 end Generic_Unconditional_Insert_With_Hint;
508 Key : Key_Type) return Node_Access
511 X : Node_Access := Tree.Root;
515 if Is_Less_Key_Node (Key, X) then
526 end Ada.Containers.Red_Black_Trees.Generic_Keys;