Commit 706a4067 by Arnaud Charlet

[multiple changes]

2011-09-27  Robert Dewar  <dewar@adacore.com>

	* exp_ch9.adb: Minor comment fixes.

2011-09-27  Ed Schonberg  <schonberg@adacore.com>

	* a-comutr.adb, a-comutr.ads: Add children iterators on multiway
	trees.

From-SVN: r179257
parent 05c1e7d2
2011-09-27 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb: Minor comment fixes.
2011-09-27 Ed Schonberg <schonberg@adacore.com>
* a-comutr.adb, a-comutr.ads: Add children iterators on multiway
trees.
2011-09-27 Eric Botcazou <ebotcazou@adacore.com>
* checks.adb (Apply_Scalar_Range_Check): Use Designated_Type
......
......@@ -40,11 +40,28 @@ package body Ada.Containers.Multiway_Trees is
From_Root : Boolean;
end record;
type Child_Iterator is new Tree_Iterator_Interfaces.Reversible_Iterator with
record
Container : Tree_Access;
Position : Cursor;
end record;
overriding function First (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
overriding function First (Object : Child_Iterator) return Cursor;
overriding function Next
(Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Previous
(Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Last (Object : Child_Iterator) return Cursor;
-----------------------
-- Local Subprograms --
-----------------------
......@@ -912,6 +929,11 @@ package body Ada.Containers.Multiway_Trees is
return Object.Position;
end First;
function First (Object : Child_Iterator) return Cursor is
begin
return (Object.Container, Object.Position.Node.Children.First);
end First;
-----------------
-- First_Child --
-----------------
......@@ -1412,6 +1434,16 @@ package body Ada.Containers.Multiway_Trees is
end loop;
end Iterate_Children;
function Iterate_Children
(Container : Tree;
Parent : Cursor)
return Tree_Iterator_Interfaces.Reversible_Iterator'Class
is
pragma Unreferenced (Container);
begin
return Child_Iterator'(Parent.Container, Parent);
end Iterate_Children;
---------------------
-- Iterate_Subtree --
---------------------
......@@ -1468,13 +1500,21 @@ package body Ada.Containers.Multiway_Trees is
Iterate_Children (Container, Subtree, Process);
end Iterate_Subtree;
----------
-- Last --
----------
overriding function Last (Object : Child_Iterator) return Cursor is
begin
return (Object.Container, Object.Position.Node.Children.Last);
end Last;
----------------
-- Last_Child --
----------------
function Last_Child (Parent : Cursor) return Cursor is
Node : Tree_Node_Access;
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
......@@ -1588,13 +1628,27 @@ package body Ada.Containers.Multiway_Trees is
end if;
else
-- If an internal node, return its first child.
return (Object.Container, N.Children.First);
end if;
end Next;
function Next
(Object : Child_Iterator;
Position : Cursor) return Cursor
is
C : constant Tree_Node_Access := Position.Node.Next;
begin
if C = null then
return No_Element;
else
return (Object.Container, C);
end if;
end Next;
------------------
-- Next_Sibling --
------------------
......@@ -1714,6 +1768,25 @@ package body Ada.Containers.Multiway_Trees is
Container.Count := Container.Count + Count;
end Prepend_Child;
--------------
-- Previous --
--------------
overriding function Previous
(Object : Child_Iterator;
Position : Cursor) return Cursor
is
C : constant Tree_Node_Access := Position.Node.Prev;
begin
if C = null then
return No_Element;
else
return (Object.Container, C);
end if;
end Previous;
----------------------
-- Previous_Sibling --
----------------------
......
......@@ -180,6 +180,11 @@ package Ada.Containers.Multiway_Trees is
function Iterate_Subtree (Position : Cursor)
return Tree_Iterator_Interfaces.Forward_Iterator'Class;
function Iterate_Children
(Container : Tree;
Parent : Cursor)
return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
function Child_Count (Parent : Cursor) return Count_Type;
function Child_Depth (Parent, Child : Cursor) return Count_Type;
......
......@@ -71,8 +71,7 @@ package body Exp_Ch9 is
-- types with defaulted discriminant of an integer type, when the bound
-- of some entry family depends on a discriminant. The limitation to
-- entry families of 128K should be reasonable in all cases, and is a
-- documented implementation restriction. It will be lifted when protected
-- entry families are re-implemented as a single ordered queue.
-- documented implementation restriction.
Entry_Family_Bound : constant Int := 2**16;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment