1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_KEYS --
9 -- Copyright (C) 2004 Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- This unit was originally developed by Matthew J Heaney. --
34 ------------------------------------------------------------------------------
36 package body Ada.Containers.Red_Black_Trees.Generic_Keys is
38 package Ops renames Tree_Operations;
46 function Ceiling (Tree : Tree_Type; Key : Key_Type) return Node_Access is
48 X : Node_Access := Tree.Root;
51 while X /= Ops.Null_Node loop
52 if Is_Greater_Key_Node (Key, X) then
67 function Find (Tree : Tree_Type; Key : Key_Type) return Node_Access is
69 X : Node_Access := Tree.Root;
72 while X /= Ops.Null_Node loop
73 if Is_Greater_Key_Node (Key, X) then
81 if Y = Ops.Null_Node then
85 if Is_Less_Key_Node (Key, Y) then
96 function Floor (Tree : Tree_Type; Key : Key_Type) return Node_Access is
98 X : Node_Access := Tree.Root;
101 while X /= Ops.Null_Node loop
102 if Is_Less_Key_Node (Key, X) then
113 --------------------------------
114 -- Generic_Conditional_Insert --
115 --------------------------------
117 procedure Generic_Conditional_Insert
118 (Tree : in out Tree_Type;
120 Node : out Node_Access;
121 Success : out Boolean)
123 Y : Node_Access := Ops.Null_Node;
124 X : Node_Access := Tree.Root;
128 while X /= Ops.Null_Node loop
130 Success := Is_Less_Key_Node (Key, X);
142 if Node = Tree.First then
143 Insert_Post (Tree, X, Y, Key, Node);
147 Node := Ops.Previous (Node);
150 if Is_Greater_Key_Node (Key, Node) then
151 Insert_Post (Tree, X, Y, Key, Node);
157 end Generic_Conditional_Insert;
159 ------------------------------------------
160 -- Generic_Conditional_Insert_With_Hint --
161 ------------------------------------------
163 procedure Generic_Conditional_Insert_With_Hint
164 (Tree : in out Tree_Type;
165 Position : Node_Access;
167 Node : out Node_Access;
168 Success : out Boolean)
171 if Position = Ops.Null_Node then -- largest
173 and then Is_Greater_Key_Node (Key, Tree.Last)
175 Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
178 Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
184 pragma Assert (Tree.Length > 0);
186 if Is_Less_Key_Node (Key, Position) then
187 if Position = Tree.First then
188 Insert_Post (Tree, Position, Position, Key, Node);
194 Before : constant Node_Access := Ops.Previous (Position);
197 if Is_Greater_Key_Node (Key, Before) then
198 if Ops.Right (Before) = Ops.Null_Node then
199 Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
201 Insert_Post (Tree, Position, Position, Key, Node);
207 Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
214 if Is_Greater_Key_Node (Key, Position) then
215 if Position = Tree.Last then
216 Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
222 After : constant Node_Access := Ops.Next (Position);
225 if Is_Less_Key_Node (Key, After) then
226 if Ops.Right (Position) = Ops.Null_Node then
227 Insert_Post (Tree, Ops.Null_Node, Position, Key, Node);
229 Insert_Post (Tree, After, After, Key, Node);
235 Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
244 end Generic_Conditional_Insert_With_Hint;
246 -------------------------
247 -- Generic_Insert_Post --
248 -------------------------
250 procedure Generic_Insert_Post
251 (Tree : in out Tree_Type;
256 subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
258 New_Length : constant Count_Type := Length_Subtype'(Tree.Length) + 1;
262 or else X /= Ops.Null_Node
263 or else Is_Less_Key_Node (Key, Y)
265 pragma Assert (Y = Ops.Null_Node
266 or else Ops.Left (Y) = Ops.Null_Node);
268 -- Delay allocation as long as we can, in order to defend
269 -- against exceptions propagated by relational operators.
273 pragma Assert (Z /= Ops.Null_Node);
274 pragma Assert (Ops.Color (Z) = Red);
276 if Y = Ops.Null_Node then
277 pragma Assert (Tree.Length = 0);
278 pragma Assert (Tree.Root = Ops.Null_Node);
279 pragma Assert (Tree.First = Ops.Null_Node);
280 pragma Assert (Tree.Last = Ops.Null_Node);
289 if Y = Tree.First then
295 pragma Assert (Ops.Right (Y) = Ops.Null_Node);
297 -- Delay allocation as long as we can, in order to defend
298 -- against exceptions propagated by relational operators.
302 pragma Assert (Z /= Ops.Null_Node);
303 pragma Assert (Ops.Color (Z) = Red);
305 Ops.Set_Right (Y, Z);
307 if Y = Tree.Last then
312 Ops.Set_Parent (Z, Y);
313 Ops.Rebalance_For_Insert (Tree, Z);
314 Tree.Length := New_Length;
315 end Generic_Insert_Post;
317 -----------------------
318 -- Generic_Iteration --
319 -----------------------
321 procedure Generic_Iteration
325 procedure Iterate (Node : Node_Access);
331 procedure Iterate (Node : Node_Access) is
332 N : Node_Access := Node;
334 while N /= Ops.Null_Node loop
335 if Is_Less_Key_Node (Key, N) then
337 elsif Is_Greater_Key_Node (Key, N) then
340 Iterate (Ops.Left (N));
347 -- Start of processing for Generic_Iteration
351 end Generic_Iteration;
353 -------------------------------
354 -- Generic_Reverse_Iteration --
355 -------------------------------
357 procedure Generic_Reverse_Iteration
361 procedure Iterate (Node : Node_Access);
367 procedure Iterate (Node : Node_Access) is
368 N : Node_Access := Node;
370 while N /= Ops.Null_Node loop
371 if Is_Less_Key_Node (Key, N) then
373 elsif Is_Greater_Key_Node (Key, N) then
376 Iterate (Ops.Right (N));
383 -- Start of processing for Generic_Reverse_Iteration
387 end Generic_Reverse_Iteration;
389 ----------------------------------
390 -- Generic_Unconditional_Insert --
391 ----------------------------------
393 procedure Generic_Unconditional_Insert
394 (Tree : in out Tree_Type;
396 Node : out Node_Access)
398 Y : Node_Access := Ops.Null_Node;
399 X : Node_Access := Tree.Root;
402 while X /= Ops.Null_Node loop
405 if Is_Less_Key_Node (Key, X) then
412 Insert_Post (Tree, X, Y, Key, Node);
413 end Generic_Unconditional_Insert;
415 --------------------------------------------
416 -- Generic_Unconditional_Insert_With_Hint --
417 --------------------------------------------
419 procedure Generic_Unconditional_Insert_With_Hint
420 (Tree : in out Tree_Type;
423 Node : out Node_Access)
425 -- TODO: verify this algorithm. It was (quickly) adapted it from the
426 -- same algorithm for conditional_with_hint. It may be that the test
427 -- Key > Hint should be something like a Key >= Hint, to handle the
428 -- case when Hint is The Last Item of A (Contiguous) sequence of
429 -- Equivalent Items. (The Key < Hint Test is probably OK. It is not
430 -- clear that you can use Key <= Hint, since new items are always
431 -- inserted last in the sequence of equivalent items.) ???
434 if Hint = Ops.Null_Node then -- largest
436 and then Is_Greater_Key_Node (Key, Tree.Last)
438 Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
440 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
446 pragma Assert (Tree.Length > 0);
448 if Is_Less_Key_Node (Key, Hint) then
449 if Hint = Tree.First then
450 Insert_Post (Tree, Hint, Hint, Key, Node);
455 Before : constant Node_Access := Ops.Previous (Hint);
457 if Is_Greater_Key_Node (Key, Before) then
458 if Ops.Right (Before) = Ops.Null_Node then
459 Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
461 Insert_Post (Tree, Hint, Hint, Key, Node);
464 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
471 if Is_Greater_Key_Node (Key, Hint) then
472 if Hint = Tree.Last then
473 Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
478 After : constant Node_Access := Ops.Next (Hint);
480 if Is_Less_Key_Node (Key, After) then
481 if Ops.Right (Hint) = Ops.Null_Node then
482 Insert_Post (Tree, Ops.Null_Node, Hint, Key, Node);
484 Insert_Post (Tree, After, After, Key, Node);
487 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
494 Unconditional_Insert_Sans_Hint (Tree, Key, Node);
495 end Generic_Unconditional_Insert_With_Hint;
503 Key : Key_Type) return Node_Access
506 X : Node_Access := Tree.Root;
509 while X /= Ops.Null_Node loop
510 if Is_Less_Key_Node (Key, X) then
521 end Ada.Containers.Red_Black_Trees.Generic_Keys;