package body Ada.Containers.Red_Black_Trees.Generic_Keys is
package Ops renames Tree_Operations;
function Ceiling (Tree : Tree_Type; Key : Key_Type) return Node_Access is
Y : Node_Access;
X : Node_Access := Tree.Root;
begin
while X /= Ops.Null_Node loop
if Is_Greater_Key_Node (Key, X) then
X := Ops.Right (X);
else
Y := X;
X := Ops.Left (X);
end if;
end loop;
return Y;
end Ceiling;
function Find (Tree : Tree_Type; Key : Key_Type) return Node_Access is
Y : Node_Access;
X : Node_Access := Tree.Root;
begin
while X /= Ops.Null_Node loop
if Is_Greater_Key_Node (Key, X) then
X := Ops.Right (X);
else
Y := X;
X := Ops.Left (X);
end if;
end loop;
if Y = Ops.Null_Node then
return Ops.Null_Node;
end if;
if Is_Less_Key_Node (Key, Y) then
return Ops.Null_Node;
end if;
return Y;
end Find;
function Floor (Tree : Tree_Type; Key : Key_Type) return Node_Access is
Y : Node_Access;
X : Node_Access := Tree.Root;
begin
while X /= Ops.Null_Node loop
if Is_Less_Key_Node (Key, X) then
X := Ops.Left (X);
else
Y := X;
X := Ops.Right (X);
end if;
end loop;
return Y;
end Floor;
procedure Generic_Conditional_Insert
(Tree : in out Tree_Type;
Key : Key_Type;
Node : out Node_Access;
Success : out Boolean)
is
Y : Node_Access := Ops.Null_Node;
X : Node_Access := Tree.Root;
begin
Success := True;
while X /= Ops.Null_Node loop
Y := X;
Success := Is_Less_Key_Node (Key, X);
if Success then
X := Ops.Left (X);
else
X := Ops.Right (X);
end if;
end loop;
Node := Y;
if Success then
if Node = Tree.First then
Insert_Post (Tree, X, Y, Key, Node);
return;
end if;
Node := Ops.Previous (Node);
end if;
if Is_Greater_Key_Node (Key, Node) then
Insert_Post (Tree, X, Y, Key, Node);
Success := True;
return;
end if;
Success := False;
end Generic_Conditional_Insert;
procedure Generic_Conditional_Insert_With_Hint
(Tree : in out Tree_Type;
Position : Node_Access;
Key : Key_Type;
Node : out Node_Access;
Success : out Boolean)
is
begin
if Position = Ops.Null_Node then if Tree.Length > 0
and then Is_Greater_Key_Node (Key, Tree.Last)
then
Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
Success := True;
else
Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
end if;
return;
end if;
pragma Assert (Tree.Length > 0);
if Is_Less_Key_Node (Key, Position) then
if Position = Tree.First then
Insert_Post (Tree, Position, Position, Key, Node);
Success := True;
return;
end if;
declare
Before : constant Node_Access := Ops.Previous (Position);
begin
if Is_Greater_Key_Node (Key, Before) then
if Ops.Right (Before) = Ops.Null_Node then
Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
else
Insert_Post (Tree, Position, Position, Key, Node);
end if;
Success := True;
else
Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
end if;
end;
return;
end if;
if Is_Greater_Key_Node (Key, Position) then
if Position = Tree.Last then
Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
Success := True;
return;
end if;
declare
After : constant Node_Access := Ops.Next (Position);
begin
if Is_Less_Key_Node (Key, After) then
if Ops.Right (Position) = Ops.Null_Node then
Insert_Post (Tree, Ops.Null_Node, Position, Key, Node);
else
Insert_Post (Tree, After, After, Key, Node);
end if;
Success := True;
else
Conditional_Insert_Sans_Hint (Tree, Key, Node, Success);
end if;
end;
return;
end if;
Node := Position;
Success := False;
end Generic_Conditional_Insert_With_Hint;
procedure Generic_Insert_Post
(Tree : in out Tree_Type;
X, Y : Node_Access;
Key : Key_Type;
Z : out Node_Access)
is
subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
New_Length : constant Count_Type := Length_Subtype'(Tree.Length) + 1;
begin
if Y = Ops.Null_Node
or else X /= Ops.Null_Node
or else Is_Less_Key_Node (Key, Y)
then
pragma Assert (Y = Ops.Null_Node
or else Ops.Left (Y) = Ops.Null_Node);
Z := New_Node;
pragma Assert (Z /= Ops.Null_Node);
pragma Assert (Ops.Color (Z) = Red);
if Y = Ops.Null_Node then
pragma Assert (Tree.Length = 0);
pragma Assert (Tree.Root = Ops.Null_Node);
pragma Assert (Tree.First = Ops.Null_Node);
pragma Assert (Tree.Last = Ops.Null_Node);
Tree.Root := Z;
Tree.First := Z;
Tree.Last := Z;
else
Ops.Set_Left (Y, Z);
if Y = Tree.First then
Tree.First := Z;
end if;
end if;
else
pragma Assert (Ops.Right (Y) = Ops.Null_Node);
Z := New_Node;
pragma Assert (Z /= Ops.Null_Node);
pragma Assert (Ops.Color (Z) = Red);
Ops.Set_Right (Y, Z);
if Y = Tree.Last then
Tree.Last := Z;
end if;
end if;
Ops.Set_Parent (Z, Y);
Ops.Rebalance_For_Insert (Tree, Z);
Tree.Length := New_Length;
end Generic_Insert_Post;
procedure Generic_Iteration
(Tree : Tree_Type;
Key : Key_Type)
is
procedure Iterate (Node : Node_Access);
procedure Iterate (Node : Node_Access) is
N : Node_Access := Node;
begin
while N /= Ops.Null_Node loop
if Is_Less_Key_Node (Key, N) then
N := Ops.Left (N);
elsif Is_Greater_Key_Node (Key, N) then
N := Ops.Right (N);
else
Iterate (Ops.Left (N));
Process (N);
N := Ops.Right (N);
end if;
end loop;
end Iterate;
begin
Iterate (Tree.Root);
end Generic_Iteration;
procedure Generic_Reverse_Iteration
(Tree : Tree_Type;
Key : Key_Type)
is
procedure Iterate (Node : Node_Access);
procedure Iterate (Node : Node_Access) is
N : Node_Access := Node;
begin
while N /= Ops.Null_Node loop
if Is_Less_Key_Node (Key, N) then
N := Ops.Left (N);
elsif Is_Greater_Key_Node (Key, N) then
N := Ops.Right (N);
else
Iterate (Ops.Right (N));
Process (N);
N := Ops.Left (N);
end if;
end loop;
end Iterate;
begin
Iterate (Tree.Root);
end Generic_Reverse_Iteration;
procedure Generic_Unconditional_Insert
(Tree : in out Tree_Type;
Key : Key_Type;
Node : out Node_Access)
is
Y : Node_Access := Ops.Null_Node;
X : Node_Access := Tree.Root;
begin
while X /= Ops.Null_Node loop
Y := X;
if Is_Less_Key_Node (Key, X) then
X := Ops.Left (X);
else
X := Ops.Right (X);
end if;
end loop;
Insert_Post (Tree, X, Y, Key, Node);
end Generic_Unconditional_Insert;
procedure Generic_Unconditional_Insert_With_Hint
(Tree : in out Tree_Type;
Hint : Node_Access;
Key : Key_Type;
Node : out Node_Access)
is
begin
if Hint = Ops.Null_Node then if Tree.Length > 0
and then Is_Greater_Key_Node (Key, Tree.Last)
then
Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
else
Unconditional_Insert_Sans_Hint (Tree, Key, Node);
end if;
return;
end if;
pragma Assert (Tree.Length > 0);
if Is_Less_Key_Node (Key, Hint) then
if Hint = Tree.First then
Insert_Post (Tree, Hint, Hint, Key, Node);
return;
end if;
declare
Before : constant Node_Access := Ops.Previous (Hint);
begin
if Is_Greater_Key_Node (Key, Before) then
if Ops.Right (Before) = Ops.Null_Node then
Insert_Post (Tree, Ops.Null_Node, Before, Key, Node);
else
Insert_Post (Tree, Hint, Hint, Key, Node);
end if;
else
Unconditional_Insert_Sans_Hint (Tree, Key, Node);
end if;
end;
return;
end if;
if Is_Greater_Key_Node (Key, Hint) then
if Hint = Tree.Last then
Insert_Post (Tree, Ops.Null_Node, Tree.Last, Key, Node);
return;
end if;
declare
After : constant Node_Access := Ops.Next (Hint);
begin
if Is_Less_Key_Node (Key, After) then
if Ops.Right (Hint) = Ops.Null_Node then
Insert_Post (Tree, Ops.Null_Node, Hint, Key, Node);
else
Insert_Post (Tree, After, After, Key, Node);
end if;
else
Unconditional_Insert_Sans_Hint (Tree, Key, Node);
end if;
end;
return;
end if;
Unconditional_Insert_Sans_Hint (Tree, Key, Node);
end Generic_Unconditional_Insert_With_Hint;
function Upper_Bound
(Tree : Tree_Type;
Key : Key_Type) return Node_Access
is
Y : Node_Access;
X : Node_Access := Tree.Root;
begin
while X /= Ops.Null_Node loop
if Is_Less_Key_Node (Key, X) then
Y := X;
X := Ops.Left (X);
else
X := Ops.Right (X);
end if;
end loop;
return Y;
end Upper_Bound;
end Ada.Containers.Red_Black_Trees.Generic_Keys;