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 /= null 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 /= null 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 = null then
return null;
end if;
if Is_Less_Key_Node (Key, Y) then
return null;
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 /= null 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 := null;
X : Node_Access := Tree.Root;
begin
Success := True;
while X /= null 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 = null then if Tree.Length > 0
and then Is_Greater_Key_Node (Key, Tree.Last)
then
Insert_Post (Tree, null, 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) = null then
Insert_Post (Tree, null, 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, null, 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) = null then
Insert_Post (Tree, null, 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
begin
if Tree.Length = Count_Type'Last then
raise Constraint_Error with "too many elements";
end if;
if Tree.Busy > 0 then
raise Program_Error with
"attempt to tamper with cursors (container is busy)";
end if;
if Y = null
or else X /= null
or else Is_Less_Key_Node (Key, Y)
then
pragma Assert (Y = null
or else Ops.Left (Y) = null);
Z := New_Node;
pragma Assert (Z /= null);
pragma Assert (Ops.Color (Z) = Red);
if Y = null then
pragma Assert (Tree.Length = 0);
pragma Assert (Tree.Root = null);
pragma Assert (Tree.First = null);
pragma Assert (Tree.Last = null);
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) = null);
Z := New_Node;
pragma Assert (Z /= null);
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 := Tree.Length + 1;
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 /= null 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 /= null 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 := null;
X : Node_Access := Tree.Root;
begin
while X /= null 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 = null then if Tree.Length > 0
and then Is_Greater_Key_Node (Key, Tree.Last)
then
Insert_Post (Tree, null, 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) = null then
Insert_Post (Tree, null, 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, null, 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) = null then
Insert_Post (Tree, null, 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 /= null 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;