| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT LIBRARY COMPONENTS -- |
| -- -- |
| -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_OPERATIONS -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2004 Free Software Foundation, Inc. -- |
| -- -- |
| -- This specification is derived from the Ada Reference Manual for use with -- |
| -- GNAT. The copyright notice above, and the license provisions that follow -- |
| -- apply solely to the contents of the part following the private keyword. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- This unit was originally developed by Matthew J Heaney. -- |
| ------------------------------------------------------------------------------ |
| |
| package body Ada.Containers.Red_Black_Trees.Generic_Operations is |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| procedure Delete_Fixup (Tree : in out Tree_Type; Node : Node_Access); |
| |
| procedure Delete_Swap (Tree : in out Tree_Type; Z, Y : Node_Access); |
| |
| procedure Left_Rotate (Tree : in out Tree_Type; X : Node_Access); |
| procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access); |
| |
| --------------------- |
| -- Check_Invariant -- |
| --------------------- |
| |
| procedure Check_Invariant (Tree : Tree_Type) is |
| Root : constant Node_Access := Tree.Root; |
| |
| function Check (Node : Node_Access) return Natural; |
| |
| ----------- |
| -- Check -- |
| ----------- |
| |
| function Check (Node : Node_Access) return Natural is |
| begin |
| if Node = Null_Node then |
| return 0; |
| end if; |
| |
| if Color (Node) = Red then |
| declare |
| L : constant Node_Access := Left (Node); |
| begin |
| pragma Assert (L = Null_Node or else Color (L) = Black); |
| null; |
| end; |
| |
| declare |
| R : constant Node_Access := Right (Node); |
| begin |
| pragma Assert (R = Null_Node or else Color (R) = Black); |
| null; |
| end; |
| |
| declare |
| NL : constant Natural := Check (Left (Node)); |
| NR : constant Natural := Check (Right (Node)); |
| begin |
| pragma Assert (NL = NR); |
| return NL; |
| end; |
| end if; |
| |
| declare |
| NL : constant Natural := Check (Left (Node)); |
| NR : constant Natural := Check (Right (Node)); |
| begin |
| pragma Assert (NL = NR); |
| return NL + 1; |
| end; |
| end Check; |
| |
| -- Start of processing for Check_Invariant |
| |
| begin |
| if Root = Null_Node then |
| pragma Assert (Tree.First = Null_Node); |
| pragma Assert (Tree.Last = Null_Node); |
| pragma Assert (Tree.Length = 0); |
| null; |
| |
| else |
| pragma Assert (Color (Root) = Black); |
| pragma Assert (Tree.Length > 0); |
| pragma Assert (Tree.Root /= Null_Node); |
| pragma Assert (Tree.First /= Null_Node); |
| pragma Assert (Tree.Last /= Null_Node); |
| pragma Assert (Parent (Tree.Root) = Null_Node); |
| pragma Assert ((Tree.Length > 1) |
| or else (Tree.First = Tree.Last |
| and Tree.First = Tree.Root)); |
| pragma Assert (Left (Tree.First) = Null_Node); |
| pragma Assert (Right (Tree.Last) = Null_Node); |
| |
| declare |
| L : constant Node_Access := Left (Root); |
| R : constant Node_Access := Right (Root); |
| NL : constant Natural := Check (L); |
| NR : constant Natural := Check (R); |
| begin |
| pragma Assert (NL = NR); |
| null; |
| end; |
| end if; |
| end Check_Invariant; |
| |
| ------------------ |
| -- Delete_Fixup -- |
| ------------------ |
| |
| procedure Delete_Fixup (Tree : in out Tree_Type; Node : Node_Access) is |
| |
| -- CLR p274 ??? |
| |
| X : Node_Access := Node; |
| W : Node_Access; |
| |
| begin |
| while X /= Tree.Root |
| and then Color (X) = Black |
| loop |
| if X = Left (Parent (X)) then |
| W := Right (Parent (X)); |
| |
| if Color (W) = Red then |
| Set_Color (W, Black); |
| Set_Color (Parent (X), Red); |
| Left_Rotate (Tree, Parent (X)); |
| W := Right (Parent (X)); |
| end if; |
| |
| if (Left (W) = Null_Node or else Color (Left (W)) = Black) |
| and then |
| (Right (W) = Null_Node or else Color (Right (W)) = Black) |
| then |
| Set_Color (W, Red); |
| X := Parent (X); |
| |
| else |
| if Right (W) = Null_Node |
| or else Color (Right (W)) = Black |
| then |
| if Left (W) /= Null_Node then |
| Set_Color (Left (W), Black); |
| end if; |
| |
| Set_Color (W, Red); |
| Right_Rotate (Tree, W); |
| W := Right (Parent (X)); |
| end if; |
| |
| Set_Color (W, Color (Parent (X))); |
| Set_Color (Parent (X), Black); |
| Set_Color (Right (W), Black); |
| Left_Rotate (Tree, Parent (X)); |
| X := Tree.Root; |
| end if; |
| |
| else |
| pragma Assert (X = Right (Parent (X))); |
| |
| W := Left (Parent (X)); |
| |
| if Color (W) = Red then |
| Set_Color (W, Black); |
| Set_Color (Parent (X), Red); |
| Right_Rotate (Tree, Parent (X)); |
| W := Left (Parent (X)); |
| end if; |
| |
| if (Left (W) = Null_Node or else Color (Left (W)) = Black) |
| and then |
| (Right (W) = Null_Node or else Color (Right (W)) = Black) |
| then |
| Set_Color (W, Red); |
| X := Parent (X); |
| |
| else |
| if Left (W) = Null_Node or else Color (Left (W)) = Black then |
| if Right (W) /= Null_Node then |
| Set_Color (Right (W), Black); |
| end if; |
| |
| Set_Color (W, Red); |
| Left_Rotate (Tree, W); |
| W := Left (Parent (X)); |
| end if; |
| |
| Set_Color (W, Color (Parent (X))); |
| Set_Color (Parent (X), Black); |
| Set_Color (Left (W), Black); |
| Right_Rotate (Tree, Parent (X)); |
| X := Tree.Root; |
| end if; |
| end if; |
| end loop; |
| |
| Set_Color (X, Black); |
| end Delete_Fixup; |
| |
| --------------------------- |
| -- Delete_Node_Sans_Free -- |
| --------------------------- |
| |
| procedure Delete_Node_Sans_Free |
| (Tree : in out Tree_Type; |
| Node : Node_Access) |
| is |
| -- CLR p273 ??? |
| |
| X, Y : Node_Access; |
| |
| Z : constant Node_Access := Node; |
| pragma Assert (Z /= Null_Node); |
| |
| begin |
| pragma Assert (Tree.Length > 0); |
| pragma Assert (Tree.Root /= Null_Node); |
| pragma Assert (Tree.First /= Null_Node); |
| pragma Assert (Tree.Last /= Null_Node); |
| pragma Assert (Parent (Tree.Root) = Null_Node); |
| pragma Assert ((Tree.Length > 1) |
| or else (Tree.First = Tree.Last |
| and then Tree.First = Tree.Root)); |
| pragma Assert ((Left (Node) = Null_Node) |
| or else (Parent (Left (Node)) = Node)); |
| pragma Assert ((Right (Node) = Null_Node) |
| or else (Parent (Right (Node)) = Node)); |
| pragma Assert (((Parent (Node) = Null_Node) and then (Tree.Root = Node)) |
| or else ((Parent (Node) /= Null_Node) and then |
| ((Left (Parent (Node)) = Node) |
| or else (Right (Parent (Node)) = Node)))); |
| |
| if Left (Z) = Null_Node then |
| if Right (Z) = Null_Node then |
| if Z = Tree.First then |
| Tree.First := Parent (Z); |
| end if; |
| |
| if Z = Tree.Last then |
| Tree.Last := Parent (Z); |
| end if; |
| |
| if Color (Z) = Black then |
| Delete_Fixup (Tree, Z); |
| end if; |
| |
| pragma Assert (Left (Z) = Null_Node); |
| pragma Assert (Right (Z) = Null_Node); |
| |
| if Z = Tree.Root then |
| pragma Assert (Tree.Length = 1); |
| pragma Assert (Parent (Z) = Null_Node); |
| Tree.Root := Null_Node; |
| elsif Z = Left (Parent (Z)) then |
| Set_Left (Parent (Z), Null_Node); |
| else |
| pragma Assert (Z = Right (Parent (Z))); |
| Set_Right (Parent (Z), Null_Node); |
| end if; |
| |
| else |
| pragma Assert (Z /= Tree.Last); |
| |
| X := Right (Z); |
| |
| if Z = Tree.First then |
| Tree.First := Min (X); |
| end if; |
| |
| if Z = Tree.Root then |
| Tree.Root := X; |
| elsif Z = Left (Parent (Z)) then |
| Set_Left (Parent (Z), X); |
| else |
| pragma Assert (Z = Right (Parent (Z))); |
| Set_Right (Parent (Z), X); |
| end if; |
| |
| Set_Parent (X, Parent (Z)); |
| |
| if Color (Z) = Black then |
| Delete_Fixup (Tree, X); |
| end if; |
| end if; |
| |
| elsif Right (Z) = Null_Node then |
| pragma Assert (Z /= Tree.First); |
| |
| X := Left (Z); |
| |
| if Z = Tree.Last then |
| Tree.Last := Max (X); |
| end if; |
| |
| if Z = Tree.Root then |
| Tree.Root := X; |
| elsif Z = Left (Parent (Z)) then |
| Set_Left (Parent (Z), X); |
| else |
| pragma Assert (Z = Right (Parent (Z))); |
| Set_Right (Parent (Z), X); |
| end if; |
| |
| Set_Parent (X, Parent (Z)); |
| |
| if Color (Z) = Black then |
| Delete_Fixup (Tree, X); |
| end if; |
| |
| else |
| pragma Assert (Z /= Tree.First); |
| pragma Assert (Z /= Tree.Last); |
| |
| Y := Next (Z); |
| pragma Assert (Left (Y) = Null_Node); |
| |
| X := Right (Y); |
| |
| if X = Null_Node then |
| if Y = Left (Parent (Y)) then |
| pragma Assert (Parent (Y) /= Z); |
| Delete_Swap (Tree, Z, Y); |
| Set_Left (Parent (Z), Z); |
| |
| else |
| pragma Assert (Y = Right (Parent (Y))); |
| pragma Assert (Parent (Y) = Z); |
| Set_Parent (Y, Parent (Z)); |
| |
| if Z = Tree.Root then |
| Tree.Root := Y; |
| elsif Z = Left (Parent (Z)) then |
| Set_Left (Parent (Z), Y); |
| else |
| pragma Assert (Z = Right (Parent (Z))); |
| Set_Right (Parent (Z), Y); |
| end if; |
| |
| Set_Left (Y, Left (Z)); |
| Set_Parent (Left (Y), Y); |
| Set_Right (Y, Z); |
| Set_Parent (Z, Y); |
| Set_Left (Z, Null_Node); |
| Set_Right (Z, Null_Node); |
| |
| declare |
| Y_Color : constant Color_Type := Color (Y); |
| begin |
| Set_Color (Y, Color (Z)); |
| Set_Color (Z, Y_Color); |
| end; |
| end if; |
| |
| if Color (Z) = Black then |
| Delete_Fixup (Tree, Z); |
| end if; |
| |
| pragma Assert (Left (Z) = Null_Node); |
| pragma Assert (Right (Z) = Null_Node); |
| |
| if Z = Right (Parent (Z)) then |
| Set_Right (Parent (Z), Null_Node); |
| else |
| pragma Assert (Z = Left (Parent (Z))); |
| Set_Left (Parent (Z), Null_Node); |
| end if; |
| |
| else |
| if Y = Left (Parent (Y)) then |
| pragma Assert (Parent (Y) /= Z); |
| |
| Delete_Swap (Tree, Z, Y); |
| |
| Set_Left (Parent (Z), X); |
| Set_Parent (X, Parent (Z)); |
| |
| else |
| pragma Assert (Y = Right (Parent (Y))); |
| pragma Assert (Parent (Y) = Z); |
| |
| Set_Parent (Y, Parent (Z)); |
| |
| if Z = Tree.Root then |
| Tree.Root := Y; |
| elsif Z = Left (Parent (Z)) then |
| Set_Left (Parent (Z), Y); |
| else |
| pragma Assert (Z = Right (Parent (Z))); |
| Set_Right (Parent (Z), Y); |
| end if; |
| |
| Set_Left (Y, Left (Z)); |
| Set_Parent (Left (Y), Y); |
| |
| declare |
| Y_Color : constant Color_Type := Color (Y); |
| begin |
| Set_Color (Y, Color (Z)); |
| Set_Color (Z, Y_Color); |
| end; |
| end if; |
| |
| if Color (Z) = Black then |
| Delete_Fixup (Tree, X); |
| end if; |
| end if; |
| end if; |
| |
| Tree.Length := Tree.Length - 1; |
| end Delete_Node_Sans_Free; |
| |
| ----------------- |
| -- Delete_Swap -- |
| ----------------- |
| |
| procedure Delete_Swap |
| (Tree : in out Tree_Type; |
| Z, Y : Node_Access) |
| is |
| pragma Assert (Z /= Y); |
| pragma Assert (Parent (Y) /= Z); |
| |
| Y_Parent : constant Node_Access := Parent (Y); |
| Y_Color : constant Color_Type := Color (Y); |
| |
| begin |
| Set_Parent (Y, Parent (Z)); |
| Set_Left (Y, Left (Z)); |
| Set_Right (Y, Right (Z)); |
| Set_Color (Y, Color (Z)); |
| |
| if Tree.Root = Z then |
| Tree.Root := Y; |
| elsif Right (Parent (Y)) = Z then |
| Set_Right (Parent (Y), Y); |
| else |
| pragma Assert (Left (Parent (Y)) = Z); |
| Set_Left (Parent (Y), Y); |
| end if; |
| |
| if Right (Y) /= Null_Node then |
| Set_Parent (Right (Y), Y); |
| end if; |
| |
| if Left (Y) /= Null_Node then |
| Set_Parent (Left (Y), Y); |
| end if; |
| |
| Set_Parent (Z, Y_Parent); |
| Set_Color (Z, Y_Color); |
| Set_Left (Z, Null_Node); |
| Set_Right (Z, Null_Node); |
| end Delete_Swap; |
| |
| ------------------- |
| -- Generic_Equal -- |
| ------------------- |
| |
| function Generic_Equal (Left, Right : Tree_Type) return Boolean is |
| L_Node : Node_Access; |
| R_Node : Node_Access; |
| |
| begin |
| if Left.Length /= Right.Length then |
| return False; |
| end if; |
| |
| L_Node := Left.First; |
| R_Node := Right.First; |
| while L_Node /= Null_Node loop |
| if not Is_Equal (L_Node, R_Node) then |
| return False; |
| end if; |
| |
| L_Node := Next (L_Node); |
| R_Node := Next (R_Node); |
| end loop; |
| |
| return True; |
| end Generic_Equal; |
| |
| ----------------------- |
| -- Generic_Iteration -- |
| ----------------------- |
| |
| procedure Generic_Iteration (Tree : Tree_Type) is |
| procedure Iterate (P : Node_Access); |
| |
| ------------- |
| -- Iterate -- |
| ------------- |
| |
| procedure Iterate (P : Node_Access) is |
| X : Node_Access := P; |
| begin |
| while X /= Null_Node loop |
| Iterate (Left (X)); |
| Process (X); |
| X := Right (X); |
| end loop; |
| end Iterate; |
| |
| -- Start of processing for Generic_Iteration |
| |
| begin |
| Iterate (Tree.Root); |
| end Generic_Iteration; |
| |
| ------------------ |
| -- Generic_Read -- |
| ------------------ |
| |
| procedure Generic_Read (Tree : in out Tree_Type; N : Count_Type) is |
| |
| pragma Assert (Tree.Length = 0); |
| -- Clear and back node reinit was done by caller |
| |
| Node, Last_Node : Node_Access; |
| |
| begin |
| if N = 0 then |
| return; |
| end if; |
| |
| Node := New_Node; |
| pragma Assert (Node /= Null_Node); |
| pragma Assert (Color (Node) = Red); |
| |
| Set_Color (Node, Black); |
| |
| Tree.Root := Node; |
| Tree.First := Node; |
| Tree.Last := Node; |
| |
| Tree.Length := 1; |
| |
| for J in Count_Type range 2 .. N loop |
| Last_Node := Node; |
| pragma Assert (Last_Node = Tree.Last); |
| |
| Node := New_Node; |
| pragma Assert (Node /= Null_Node); |
| pragma Assert (Color (Node) = Red); |
| |
| Set_Right (Node => Last_Node, Right => Node); |
| Tree.Last := Node; |
| Set_Parent (Node => Node, Parent => Last_Node); |
| Rebalance_For_Insert (Tree, Node); |
| Tree.Length := Tree.Length + 1; |
| end loop; |
| end Generic_Read; |
| |
| ------------------------------- |
| -- Generic_Reverse_Iteration -- |
| ------------------------------- |
| |
| procedure Generic_Reverse_Iteration (Tree : Tree_Type) |
| is |
| procedure Iterate (P : Node_Access); |
| |
| ------------- |
| -- Iterate -- |
| ------------- |
| |
| procedure Iterate (P : Node_Access) is |
| X : Node_Access := P; |
| begin |
| while X /= Null_Node loop |
| Iterate (Right (X)); |
| Process (X); |
| X := Left (X); |
| end loop; |
| end Iterate; |
| |
| -- Start of processing for Generic_Reverse_Iteration |
| |
| begin |
| Iterate (Tree.Root); |
| end Generic_Reverse_Iteration; |
| |
| ----------------- |
| -- Left_Rotate -- |
| ----------------- |
| |
| procedure Left_Rotate (Tree : in out Tree_Type; X : Node_Access) is |
| |
| -- CLR p266 ??? |
| |
| Y : constant Node_Access := Right (X); |
| pragma Assert (Y /= Null_Node); |
| |
| begin |
| Set_Right (X, Left (Y)); |
| |
| if Left (Y) /= Null_Node then |
| Set_Parent (Left (Y), X); |
| end if; |
| |
| Set_Parent (Y, Parent (X)); |
| |
| if X = Tree.Root then |
| Tree.Root := Y; |
| elsif X = Left (Parent (X)) then |
| Set_Left (Parent (X), Y); |
| else |
| pragma Assert (X = Right (Parent (X))); |
| Set_Right (Parent (X), Y); |
| end if; |
| |
| Set_Left (Y, X); |
| Set_Parent (X, Y); |
| end Left_Rotate; |
| |
| --------- |
| -- Max -- |
| --------- |
| |
| function Max (Node : Node_Access) return Node_Access is |
| |
| -- CLR p248 ??? |
| |
| X : Node_Access := Node; |
| Y : Node_Access; |
| |
| begin |
| loop |
| Y := Right (X); |
| |
| if Y = Null_Node then |
| return X; |
| end if; |
| |
| X := Y; |
| end loop; |
| end Max; |
| |
| --------- |
| -- Min -- |
| --------- |
| |
| function Min (Node : Node_Access) return Node_Access is |
| |
| -- CLR p248 ??? |
| |
| X : Node_Access := Node; |
| Y : Node_Access; |
| |
| begin |
| loop |
| Y := Left (X); |
| |
| if Y = Null_Node then |
| return X; |
| end if; |
| |
| X := Y; |
| end loop; |
| end Min; |
| |
| ---------- |
| -- Move -- |
| ---------- |
| |
| procedure Move (Target, Source : in out Tree_Type) is |
| begin |
| if Target.Length > 0 then |
| raise Constraint_Error; |
| end if; |
| |
| Target := Source; |
| Source := (First => Null_Node, |
| Last => Null_Node, |
| Root => Null_Node, |
| Length => 0); |
| end Move; |
| |
| ---------- |
| -- Next -- |
| ---------- |
| |
| function Next (Node : Node_Access) return Node_Access is |
| begin |
| -- CLR p249 ??? |
| |
| if Node = Null_Node then |
| return Null_Node; |
| end if; |
| |
| if Right (Node) /= Null_Node then |
| return Min (Right (Node)); |
| end if; |
| |
| declare |
| X : Node_Access := Node; |
| Y : Node_Access := Parent (Node); |
| |
| begin |
| while Y /= Null_Node |
| and then X = Right (Y) |
| loop |
| X := Y; |
| Y := Parent (Y); |
| end loop; |
| |
| -- Why is this code commented out ??? |
| |
| -- if Right (X) /= Y then |
| -- return Y; |
| -- else |
| -- return X; |
| -- end if; |
| |
| return Y; |
| end; |
| end Next; |
| |
| -------------- |
| -- Previous -- |
| -------------- |
| |
| function Previous (Node : Node_Access) return Node_Access is |
| begin |
| if Node = Null_Node then |
| return Null_Node; |
| end if; |
| |
| if Left (Node) /= Null_Node then |
| return Max (Left (Node)); |
| end if; |
| |
| declare |
| X : Node_Access := Node; |
| Y : Node_Access := Parent (Node); |
| |
| begin |
| while Y /= Null_Node |
| and then X = Left (Y) |
| loop |
| X := Y; |
| Y := Parent (Y); |
| end loop; |
| |
| -- Why is this code commented out ??? |
| |
| -- if Left (X) /= Y then |
| -- return Y; |
| -- else |
| -- return X; |
| -- end if; |
| |
| return Y; |
| end; |
| end Previous; |
| |
| -------------------------- |
| -- Rebalance_For_Insert -- |
| -------------------------- |
| |
| procedure Rebalance_For_Insert |
| (Tree : in out Tree_Type; |
| Node : Node_Access) |
| is |
| -- CLR p.268 ??? |
| |
| X : Node_Access := Node; |
| pragma Assert (X /= Null_Node); |
| pragma Assert (Color (X) = Red); |
| |
| Y : Node_Access; |
| |
| begin |
| while X /= Tree.Root and then Color (Parent (X)) = Red loop |
| if Parent (X) = Left (Parent (Parent (X))) then |
| Y := Right (Parent (Parent (X))); |
| |
| if Y /= Null_Node and then Color (Y) = Red then |
| Set_Color (Parent (X), Black); |
| Set_Color (Y, Black); |
| Set_Color (Parent (Parent (X)), Red); |
| X := Parent (Parent (X)); |
| |
| else |
| if X = Right (Parent (X)) then |
| X := Parent (X); |
| Left_Rotate (Tree, X); |
| end if; |
| |
| Set_Color (Parent (X), Black); |
| Set_Color (Parent (Parent (X)), Red); |
| Right_Rotate (Tree, Parent (Parent (X))); |
| end if; |
| |
| else |
| pragma Assert (Parent (X) = Right (Parent (Parent (X)))); |
| |
| Y := Left (Parent (Parent (X))); |
| |
| if Y /= Null_Node and then Color (Y) = Red then |
| Set_Color (Parent (X), Black); |
| Set_Color (Y, Black); |
| Set_Color (Parent (Parent (X)), Red); |
| X := Parent (Parent (X)); |
| |
| else |
| if X = Left (Parent (X)) then |
| X := Parent (X); |
| Right_Rotate (Tree, X); |
| end if; |
| |
| Set_Color (Parent (X), Black); |
| Set_Color (Parent (Parent (X)), Red); |
| Left_Rotate (Tree, Parent (Parent (X))); |
| end if; |
| end if; |
| end loop; |
| |
| Set_Color (Tree.Root, Black); |
| end Rebalance_For_Insert; |
| |
| ------------------ |
| -- Right_Rotate -- |
| ------------------ |
| |
| procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access) is |
| X : constant Node_Access := Left (Y); |
| pragma Assert (X /= Null_Node); |
| |
| begin |
| Set_Left (Y, Right (X)); |
| |
| if Right (X) /= Null_Node then |
| Set_Parent (Right (X), Y); |
| end if; |
| |
| Set_Parent (X, Parent (Y)); |
| |
| if Y = Tree.Root then |
| Tree.Root := X; |
| elsif Y = Left (Parent (Y)) then |
| Set_Left (Parent (Y), X); |
| else |
| pragma Assert (Y = Right (Parent (Y))); |
| Set_Right (Parent (Y), X); |
| end if; |
| |
| Set_Right (X, Y); |
| Set_Parent (Y, X); |
| end Right_Rotate; |
| |
| end Ada.Containers.Red_Black_Trees.Generic_Operations; |
