The iterators for the multiway trees are now implemented as a type
hierarchy. Iterating over a tree is the same as iterating over a subtree
starting from the root, and so the tree iterator forwards the request to the
subtree iterator.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-12-02 Matthew Heaney <hea...@adacore.com>
* a-cbmutr.ads (No_Node): Moved declaration from body to spec
* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Iterator): Derives
from Root_Iterator.
(Child_Iterator): Derives from Root_Iterator.
(Finalize): Implemented as an override operation for Root_Iterator.
(First): Return value depends on Subtree component.
(Last): Component was renamed from Parent to Subtree.
(Next): Checks parameter value, and uses simplified loop.
(Iterate): Forwards to Iterate_Subtree.
(Iterate_Children): Component was renamed from Parent to Subtree.
(Iterate_Subtree): Checks parameter value
Index: a-cimutr.adb
===================================================================
--- a-cimutr.adb (revision 181914)
+++ a-cimutr.adb (working copy)
@@ -33,41 +33,50 @@
package body Ada.Containers.Indefinite_Multiway_Trees is
- type Iterator is new Limited_Controlled and
+ --------------------
+ -- Root_Iterator --
+ --------------------
+
+ type Root_Iterator is abstract new Limited_Controlled and
Tree_Iterator_Interfaces.Forward_Iterator with
record
Container : Tree_Access;
- Position : Cursor;
- From_Root : Boolean;
+ Subtree : Tree_Node_Access;
end record;
- type Child_Iterator is new Limited_Controlled and
- Tree_Iterator_Interfaces.Reversible_Iterator with
- record
- Container : Tree_Access;
- Parent : Tree_Node_Access;
- end record;
+ overriding procedure Finalize (Object : in out Root_Iterator);
- overriding procedure Finalize (Object : in out Iterator);
+ -----------------------
+ -- Subtree_Iterator --
+ -----------------------
- overriding function First (Object : Iterator) return Cursor;
+ type Subtree_Iterator is new Root_Iterator with null record;
+
+ overriding function First (Object : Subtree_Iterator) return Cursor;
+
overriding function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor;
- overriding procedure Finalize (Object : in out Child_Iterator);
+ ---------------------
+ -- Child_Iterator --
+ ---------------------
+ type Child_Iterator is new Root_Iterator and
+ Tree_Iterator_Interfaces.Reversible_Iterator with null record;
+
overriding function First (Object : Child_Iterator) return Cursor;
+
overriding function Next
(Object : Child_Iterator;
Position : Cursor) return Cursor;
+ overriding function Last (Object : Child_Iterator) return Cursor;
+
overriding function Previous
(Object : Child_Iterator;
Position : Cursor) return Cursor;
- overriding function Last (Object : Child_Iterator) return Cursor;
-
-----------------------
-- Local Subprograms --
-----------------------
@@ -936,18 +945,12 @@
-- Finalize --
--------------
- procedure Finalize (Object : in out Iterator) is
+ procedure Finalize (Object : in out Root_Iterator) is
B : Natural renames Object.Container.Busy;
begin
B := B - 1;
end Finalize;
- procedure Finalize (Object : in out Child_Iterator) is
- B : Natural renames Object.Container.Busy;
- begin
- B := B - 1;
- end Finalize;
-
----------
-- Find --
----------
@@ -971,14 +974,18 @@
-- First --
-----------
- function First (Object : Iterator) return Cursor is
+ overriding function First (Object : Subtree_Iterator) return Cursor is
begin
- return Object.Position;
+ if Object.Subtree = Root_Node (Object.Container.all) then
+ return First_Child (Root (Object.Container.all));
+ else
+ return Cursor'(Object.Container, Object.Subtree);
+ end if;
end First;
- function First (Object : Child_Iterator) return Cursor is
+ overriding function First (Object : Child_Iterator) return Cursor is
begin
- return First_Child (Cursor'(Object.Container, Object.Parent));
+ return First_Child (Cursor'(Object.Container, Object.Subtree));
end First;
-----------------
@@ -1348,18 +1355,8 @@
function Iterate (Container : Tree)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Container'Unrestricted_Access.all.Busy;
- RC : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Position => First_Child (RC),
- From_Root => True)
- do
- B := B + 1;
- end return;
+ return Iterate_Subtree (Root (Container));
end Iterate;
----------------------
@@ -1438,7 +1435,7 @@
return It : constant Child_Iterator :=
Child_Iterator'(Limited_Controlled with
Container => C,
- Parent => Parent.Node)
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
@@ -1452,17 +1449,25 @@
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Position.Container'Unrestricted_Access.all.Busy;
-
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Position.Container,
- Position => Position,
- From_Root => False)
- do
- B := B + 1;
- end return;
+ if Position = No_Element then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ -- Implement Vet for multiway trees???
+ -- pragma Assert (Vet (Position), "bad subtree cursor");
+
+ declare
+ B : Natural renames Position.Container.Busy;
+ begin
+ return It : constant Subtree_Iterator :=
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
+ do
+ B := B + 1;
+ end return;
+ end;
end Iterate_Subtree;
procedure Iterate_Subtree
@@ -1515,7 +1520,7 @@
overriding function Last (Object : Child_Iterator) return Cursor is
begin
- return Last_Child (Cursor'(Object.Container, Object.Parent));
+ return Last_Child (Cursor'(Object.Container, Object.Subtree));
end Last;
----------------
@@ -1585,63 +1590,36 @@
----------
function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor
is
- T : Tree renames Position.Container.all;
- N : constant Tree_Node_Access := Position.Node;
+ Node : Tree_Node_Access;
begin
- if Is_Leaf (Position) then
+ if Position.Container = null then
+ return No_Element;
+ end if;
- -- If sibling is present, return it
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong tree";
+ end if;
- if N.Next /= null then
- return (Object.Container, N.Next);
+ Node := Position.Node;
- -- If this is the last sibling, go to sibling of first ancestor that
- -- has a sibling, or terminate.
+ if Node.Children.First /= null then
+ return Cursor'(Object.Container, Node.Children.First);
+ end if;
- else
- declare
- Par : Tree_Node_Access := N.Parent;
-
- begin
- while Par.Next = null loop
-
- -- If we are back at the root the iteration is complete
-
- if Par = Root_Node (T) then
- return No_Element;
-
- -- If this is a subtree iterator and we are back at the
- -- starting node, iteration is complete.
-
- elsif Par = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
-
- else
- Par := Par.Parent;
- end if;
- end loop;
-
- if Par = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
- end if;
-
- return (Object.Container, Par.Next);
- end;
+ while Node /= Object.Subtree loop
+ if Node.Next /= null then
+ return Cursor'(Object.Container, Node.Next);
end if;
- -- If an internal node, return its first child
+ Node := Node.Parent;
+ end loop;
- else
- return (Object.Container, N.Children.First);
- end if;
+ return No_Element;
end Next;
function Next
Index: a-comutr.adb
===================================================================
--- a-comutr.adb (revision 181914)
+++ a-comutr.adb (working copy)
@@ -34,41 +34,50 @@
package body Ada.Containers.Multiway_Trees is
- type Iterator is new Limited_Controlled and
+ --------------------
+ -- Root_Iterator --
+ --------------------
+
+ type Root_Iterator is abstract new Limited_Controlled and
Tree_Iterator_Interfaces.Forward_Iterator with
record
Container : Tree_Access;
- Position : Cursor;
- From_Root : Boolean;
+ Subtree : Tree_Node_Access;
end record;
- type Child_Iterator is new Limited_Controlled and
- Tree_Iterator_Interfaces.Reversible_Iterator with
- record
- Container : Tree_Access;
- Parent : Tree_Node_Access;
- end record;
+ overriding procedure Finalize (Object : in out Root_Iterator);
- overriding procedure Finalize (Object : in out Iterator);
+ -----------------------
+ -- Subtree_Iterator --
+ -----------------------
- overriding function First (Object : Iterator) return Cursor;
+ type Subtree_Iterator is new Root_Iterator with null record;
+
+ overriding function First (Object : Subtree_Iterator) return Cursor;
+
overriding function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor;
- overriding procedure Finalize (Object : in out Child_Iterator);
+ ---------------------
+ -- Child_Iterator --
+ ---------------------
+ type Child_Iterator is new Root_Iterator and
+ Tree_Iterator_Interfaces.Reversible_Iterator with null record;
+
overriding function First (Object : Child_Iterator) return Cursor;
+
overriding function Next
(Object : Child_Iterator;
Position : Cursor) return Cursor;
+ overriding function Last (Object : Child_Iterator) return Cursor;
+
overriding function Previous
(Object : Child_Iterator;
Position : Cursor) return Cursor;
- overriding function Last (Object : Child_Iterator) return Cursor;
-
-----------------------
-- Local Subprograms --
-----------------------
@@ -909,18 +918,12 @@
-- Finalize --
--------------
- procedure Finalize (Object : in out Iterator) is
+ procedure Finalize (Object : in out Root_Iterator) is
B : Natural renames Object.Container.Busy;
begin
B := B - 1;
end Finalize;
- procedure Finalize (Object : in out Child_Iterator) is
- B : Natural renames Object.Container.Busy;
- begin
- B := B - 1;
- end Finalize;
-
----------
-- Find --
----------
@@ -943,14 +946,18 @@
-- First --
-----------
- function First (Object : Iterator) return Cursor is
+ overriding function First (Object : Subtree_Iterator) return Cursor is
begin
- return Object.Position;
+ if Object.Subtree = Root_Node (Object.Container.all) then
+ return First_Child (Root (Object.Container.all));
+ else
+ return Cursor'(Object.Container, Object.Subtree);
+ end if;
end First;
- function First (Object : Child_Iterator) return Cursor is
+ overriding function First (Object : Child_Iterator) return Cursor is
begin
- return First_Child (Cursor'(Object.Container, Object.Parent));
+ return First_Child (Cursor'(Object.Container, Object.Subtree));
end First;
-----------------
@@ -1376,18 +1383,8 @@
function Iterate (Container : Tree)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Container'Unrestricted_Access.all.Busy;
- RC : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Position => First_Child (RC),
- From_Root => True)
- do
- B := B + 1;
- end return;
+ return Iterate_Subtree (Root (Container));
end Iterate;
----------------------
@@ -1464,9 +1461,9 @@
end if;
return It : constant Child_Iterator :=
- Child_Iterator'(Limited_Controlled with
- Container => C,
- Parent => Parent.Node)
+ (Limited_Controlled with
+ Container => C,
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
@@ -1480,16 +1477,25 @@
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Position.Container'Unrestricted_Access.all.Busy;
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Position.Container,
- Position => Position,
- From_Root => False)
- do
- B := B + 1;
- end return;
+ if Position = No_Element then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ -- Implement Vet for multiway trees???
+ -- pragma Assert (Vet (Position), "bad subtree cursor");
+
+ declare
+ B : Natural renames Position.Container.Busy;
+ begin
+ return It : constant Subtree_Iterator :=
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
+ do
+ B := B + 1;
+ end return;
+ end;
end Iterate_Subtree;
procedure Iterate_Subtree
@@ -1542,7 +1548,7 @@
overriding function Last (Object : Child_Iterator) return Cursor is
begin
- return Last_Child (Cursor'(Object.Container, Object.Parent));
+ return Last_Child (Cursor'(Object.Container, Object.Subtree));
end Last;
----------------
@@ -1612,63 +1618,36 @@
----------
function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor
is
- T : Tree renames Position.Container.all;
- N : constant Tree_Node_Access := Position.Node;
+ Node : Tree_Node_Access;
begin
- if Is_Leaf (Position) then
+ if Position.Container = null then
+ return No_Element;
+ end if;
- -- If sibling is present, return it
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong tree";
+ end if;
- if N.Next /= null then
- return (Object.Container, N.Next);
+ Node := Position.Node;
- -- If this is the last sibling, go to sibling of first ancestor that
- -- has a sibling, or terminate.
+ if Node.Children.First /= null then
+ return Cursor'(Object.Container, Node.Children.First);
+ end if;
- else
- declare
- Par : Tree_Node_Access := N.Parent;
-
- begin
- while Par.Next = null loop
-
- -- If we are back at the root the iteration is complete
-
- if Par = Root_Node (T) then
- return No_Element;
-
- -- If this is a subtree iterator and we are back at the
- -- starting node, iteration is complete.
-
- elsif Par = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
-
- else
- Par := Par.Parent;
- end if;
- end loop;
-
- if Par = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
- end if;
-
- return (Object.Container, Par.Next);
- end;
+ while Node /= Object.Subtree loop
+ if Node.Next /= null then
+ return Cursor'(Object.Container, Node.Next);
end if;
- else
- -- If an internal node, return its first child
+ Node := Node.Parent;
+ end loop;
- return (Object.Container, N.Children.First);
- end if;
+ return No_Element;
end Next;
function Next
Index: a-cbmutr.adb
===================================================================
--- a-cbmutr.adb (revision 181914)
+++ a-cbmutr.adb (working copy)
@@ -33,32 +33,37 @@
package body Ada.Containers.Bounded_Multiway_Trees is
- No_Node : constant Count_Type'Base := -1;
+ --------------------
+ -- Root_Iterator --
+ --------------------
- type Iterator is new Limited_Controlled and
+ type Root_Iterator is abstract new Limited_Controlled and
Tree_Iterator_Interfaces.Forward_Iterator with
record
Container : Tree_Access;
- Position : Cursor;
- From_Root : Boolean;
+ Subtree : Count_Type;
end record;
- overriding procedure Finalize (Object : in out Iterator);
+ overriding procedure Finalize (Object : in out Root_Iterator);
- overriding function First (Object : Iterator) return Cursor;
+ -----------------------
+ -- Subtree_Iterator --
+ -----------------------
+ type Subtree_Iterator is new Root_Iterator with null record;
+
+ overriding function First (Object : Subtree_Iterator) return Cursor;
+
overriding function Next
- (Object : Iterator;
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor;
- type Child_Iterator is new Limited_Controlled and
- Tree_Iterator_Interfaces.Reversible_Iterator with
- record
- Container : Tree_Access;
- Parent : Count_Type;
- end record;
+ ---------------------
+ -- Child_Iterator --
+ ---------------------
- overriding procedure Finalize (Object : in out Child_Iterator);
+ type Child_Iterator is new Root_Iterator and
+ Tree_Iterator_Interfaces.Reversible_Iterator with null record;
overriding function First (Object : Child_Iterator) return Cursor;
@@ -66,12 +71,12 @@
(Object : Child_Iterator;
Position : Cursor) return Cursor;
+ overriding function Last (Object : Child_Iterator) return Cursor;
+
overriding function Previous
(Object : Child_Iterator;
Position : Cursor) return Cursor;
- overriding function Last (Object : Child_Iterator) return Cursor;
-
-----------------------
-- Local Subprograms --
-----------------------
@@ -1242,18 +1247,12 @@
-- Finalize --
--------------
- procedure Finalize (Object : in out Iterator) is
+ procedure Finalize (Object : in out Root_Iterator) is
B : Natural renames Object.Container.Busy;
begin
B := B - 1;
end Finalize;
- procedure Finalize (Object : in out Child_Iterator) is
- B : Natural renames Object.Container.Busy;
- begin
- B := B - 1;
- end Finalize;
-
----------
-- Find --
----------
@@ -1278,14 +1277,22 @@
return Cursor'(Container'Unrestricted_Access, Node);
end Find;
- function First (Object : Iterator) return Cursor is
+ -----------
+ -- First --
+ -----------
+
+ overriding function First (Object : Subtree_Iterator) return Cursor is
begin
- return Object.Position;
+ if Object.Subtree = Root_Node (Object.Container.all) then
+ return First_Child (Root (Object.Container.all));
+ else
+ return Cursor'(Object.Container, Object.Subtree);
+ end if;
end First;
- function First (Object : Child_Iterator) return Cursor is
+ overriding function First (Object : Child_Iterator) return Cursor is
begin
- return First_Child (Cursor'(Object.Container, Object.Parent));
+ return First_Child (Cursor'(Object.Container, Object.Subtree));
end First;
-----------------
@@ -1780,19 +1787,8 @@
function Iterate (Container : Tree)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Container'Unrestricted_Access.all.Busy;
- RC : constant Cursor :=
- (Container'Unrestricted_Access, Root_Node (Container));
-
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Position => First_Child (RC),
- From_Root => True)
- do
- B := B + 1;
- end return;
+ return Iterate_Subtree (Root (Container));
end Iterate;
----------------------
@@ -1879,7 +1875,7 @@
return It : constant Child_Iterator :=
Child_Iterator'(Limited_Controlled with
Container => C,
- Parent => Parent.Node)
+ Subtree => Parent.Node)
do
B := B + 1;
end return;
@@ -1893,17 +1889,25 @@
(Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class
is
- B : Natural renames Position.Container.all.Busy;
-
begin
- return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Position.Container,
- Position => Position,
- From_Root => False)
- do
- B := B + 1;
- end return;
+ if Position = No_Element then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ -- Implement Vet for multiway trees???
+ -- pragma Assert (Vet (Position), "bad subtree cursor");
+
+ declare
+ B : Natural renames Position.Container.Busy;
+ begin
+ return It : constant Subtree_Iterator :=
+ (Limited_Controlled with
+ Container => Position.Container,
+ Subtree => Position.Node)
+ do
+ B := B + 1;
+ end return;
+ end;
end Iterate_Subtree;
procedure Iterate_Subtree
@@ -1962,7 +1966,7 @@
overriding function Last (Object : Child_Iterator) return Cursor is
begin
- return Last_Child (Cursor'(Object.Container, Object.Parent));
+ return Last_Child (Cursor'(Object.Container, Object.Subtree));
end Last;
----------------
@@ -2023,67 +2027,43 @@
-- Next --
----------
- function Next
- (Object : Iterator;
+ overriding function Next
+ (Object : Subtree_Iterator;
Position : Cursor) return Cursor
is
- T : Tree renames Position.Container.all;
- NN : Tree_Node_Array renames T.Nodes;
- N : Tree_Node_Type renames NN (Position.Node);
-
begin
- if Is_Leaf (Position) then
+ if Position.Container = null then
+ return No_Element;
+ end if;
- -- If sibling is present, return it
+ if Position.Container /= Object.Container then
+ raise Program_Error with
+ "Position cursor of Next designates wrong tree";
+ end if;
- if N.Next /= 0 then
- return (Object.Container, N.Next);
+ pragma Assert (Object.Container.Count > 0);
+ pragma Assert (Position.Node /= Root_Node (Object.Container.all));
- -- If this is the last sibling, go to sibling of first ancestor that
- -- has a sibling, or terminate.
+ declare
+ Nodes : Tree_Node_Array renames Object.Container.Nodes;
+ Node : Count_Type;
+ begin
+ Node := Position.Node;
- else
- declare
- Pos : Count_Type := N.Parent;
- Par : Tree_Node_Type := NN (Pos);
-
- begin
- while Par.Next = 0 loop
- Pos := Par.Parent;
-
- -- If we are back at the root the iteration is complete
-
- if Pos = No_Node then
- return No_Element;
-
- -- If this is a subtree iterator and we are back at the
- -- starting node, iteration is complete.
-
- elsif Pos = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
-
- else
- Par := NN (Pos);
- end if;
- end loop;
-
- if Pos = Object.Position.Node
- and then not Object.From_Root
- then
- return No_Element;
- end if;
-
- return (Object.Container, Par.Next);
- end;
+ if Nodes (Node).Children.First > 0 then
+ return Cursor'(Object.Container, Nodes (Node).Children.First);
end if;
- -- If an internal node, return its first child
+ while Node /= Object.Subtree loop
+ if Nodes (Node).Next > 0 then
+ return Cursor'(Object.Container, Nodes (Node).Next);
+ end if;
- else
- return (Object.Container, N.Children.First);
- end if;
+ Node := Nodes (Node).Parent;
+ end loop;
+
+ return No_Element;
+ end;
end Next;
overriding function Next
@@ -2100,6 +2080,9 @@
"Position cursor of Next designates wrong tree";
end if;
+ pragma Assert (Object.Container.Count > 0);
+ pragma Assert (Position.Node /= Root_Node (Object.Container.all));
+
return Next_Sibling (Position);
end Next;
Index: a-cbmutr.ads
===================================================================
--- a-cbmutr.ads (revision 181910)
+++ a-cbmutr.ads (working copy)
@@ -301,6 +301,8 @@
private
use Ada.Streams;
+ No_Node : constant Count_Type'Base := -1;
+
type Children_Type is record
First : Count_Type'Base;
Last : Count_Type'Base;
@@ -319,7 +321,7 @@
type Tree (Capacity : Count_Type) is tagged record
Nodes : Tree_Node_Array (0 .. Capacity) := (others => <>);
Elements : Element_Array (1 .. Capacity) := (others => <>);
- Free : Count_Type'Base := -1;
+ Free : Count_Type'Base := No_Node;
Busy : Integer := 0;
Lock : Integer := 0;
Count : Count_Type := 0;
@@ -342,7 +344,7 @@
type Cursor is record
Container : Tree_Access;
- Node : Count_Type'Base := -1;
+ Node : Count_Type'Base := No_Node;
end record;
procedure Read
