===================================================================
@@ -26,9 +26,30 @@
------------------------------------------------------------------------------
with System; use type System.Address;
+with Ada.Finalization;
package body Ada.Containers.Formal_Doubly_Linked_Lists is
+ type Iterator is new Ada.Finalization.Limited_Controlled and
+ List_Iterator_Interfaces.Reversible_Iterator with
+ record
+ Container : List_Access;
+ Node : Count_Type;
+ end record;
+
+ overriding procedure Finalize (Object : in out Iterator);
+
+ overriding function First (Object : Iterator) return Cursor;
+ overriding function Last (Object : Iterator) return Cursor;
+
+ overriding function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
+ overriding function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor;
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -423,6 +444,21 @@
return Container.Nodes (Position.Node).Element;
end Element;
+ --------------
+ -- Finalize --
+ --------------
+
+ procedure Finalize (Object : in out Iterator) is
+ begin
+ if Object.Container /= null then
+ declare
+ B : Natural renames Object.Container.all.Busy;
+ begin
+ B := B - 1;
+ end;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
@@ -474,6 +510,28 @@
return (Node => Container.First);
end First;
+ function First (Object : Iterator) return Cursor is
+ begin
+ -- The value of the iterator object's Node component influences the
+ -- behavior of the First (and Last) selector function.
+
+ -- When the Node component is null, this means the iterator object was
+ -- constructed without a start expression, in which case the (forward)
+ -- iteration starts from the (logical) beginning of the entire sequence
+ -- of items (corresponding to Container.First, for a forward iterator).
+
+ -- Otherwise, this is iteration over a partial sequence of items. When
+ -- the Node component is non-null, the iterator object was constructed
+ -- with a start expression, that specifies the position from which the
+ -- (forward) partial iteration begins.
+
+ if Object.Node = 0 then
+ return First (Object.Container.all);
+ else
+ return (Node => Object.Node);
+ end if;
+ end First;
+
-------------------
-- First_Element --
-------------------
@@ -915,6 +973,71 @@
B := B - 1;
end Iterate;
+ function Iterate (Container : List)
+ return List_Iterator_Interfaces.Reversible_Iterator'Class
+ is
+ B : Natural renames Container'Unrestricted_Access.all.Busy;
+
+ begin
+ -- The value of the Node component influences the behavior of the First
+ -- and Last selector functions of the iterator object. When the Node
+ -- component is null (as is the case here), this means the iterator
+ -- object was constructed without a start expression. This is a
+ -- complete iterator, meaning that the iteration starts from the
+ -- (logical) beginning of the sequence of items.
+
+ -- Note: For a forward iterator, Container.First is the beginning, and
+ -- for a reverse iterator, Container.Last is the beginning.
+
+ return It : constant Iterator :=
+ Iterator'(Ada.Finalization.Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => 0)
+ do
+ B := B + 1;
+ end return;
+ end Iterate;
+
+ function Iterate (Container : List; Start : Cursor)
+ return List_Iterator_Interfaces.Reversible_Iterator'Class
+ is
+ B : Natural renames Container'Unrestricted_Access.all.Busy;
+
+ begin
+ -- It was formerly the case that when Start = No_Element, the partial
+ -- iterator was defined to behave the same as for a complete iterator,
+ -- and iterate over the entire sequence of items. However, those
+ -- semantics were unintuitive and arguably error-prone (it is too easy
+ -- to accidentally create an endless loop), and so they were changed,
+ -- per the ARG meeting in Denver on 2011/11. However, there was no
+ -- consensus about what positive meaning this corner case should have,
+ -- and so it was decided to simply raise an exception. This does imply,
+ -- however, that it is not possible to use a partial iterator to specify
+ -- an empty sequence of items.
+
+ if not Has_Element (Container, Start) then
+ raise Constraint_Error with
+ "Start position for iterator is not a valid cursor";
+ end if;
+
+ -- The value of the Node component influences the behavior of the First
+ -- and Last selector functions of the iterator object. When the Node
+ -- component is non-null (as is the case here), it means that this
+ -- is a partial iteration, over a subset of the complete sequence of
+ -- items. The iterator object was constructed with a start expression,
+ -- indicating the position from which the iteration begins. Note that
+ -- the start position has the same value irrespective of whether this
+ -- is a forward or reverse iteration.
+
+ return It : constant Iterator :=
+ Iterator'(Ada.Finalization.Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
+ do
+ B := B + 1;
+ end return;
+ end Iterate;
+
----------
-- Last --
----------
@@ -927,6 +1050,28 @@
return (Node => Container.Last);
end Last;
+ function Last (Object : Iterator) return Cursor is
+ begin
+ -- The value of the iterator object's Node component influences the
+ -- behavior of the Last (and First) selector function.
+
+ -- When the Node component is null, this means the iterator object was
+ -- constructed without a start expression, in which case the (reverse)
+ -- iteration starts from the (logical) beginning of the entire sequence
+ -- (corresponding to Container.Last, for a reverse iterator).
+
+ -- Otherwise, this is iteration over a partial sequence of items. When
+ -- the Node component is non-null, the iterator object was constructed
+ -- with a start expression, that specifies the position from which the
+ -- (reverse) partial iteration begins.
+
+ if Object.Node = 0 then
+ return Last (Object.Container.all);
+ else
+ return (Node => Object.Node);
+ end if;
+ end Last;
+
------------------
-- Last_Element --
------------------
@@ -1085,6 +1230,24 @@
return (Node => Container.Nodes (Position.Node).Next);
end Next;
+ function Next
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+
+ return Next (Object.Container.all, Position);
+ end Next;
+
+ --------------------
+ -- Not_No_Element --
+ --------------------
+
+ function Not_No_Element (Position : Cursor) return Boolean is
+ begin
+ return Position /= No_Element;
+ end Not_No_Element;
+
-------------
-- Prepend --
-------------
@@ -1120,6 +1283,15 @@
return (Node => Container.Nodes (Position.Node).Prev);
end Previous;
+ function Previous
+ (Object : Iterator;
+ Position : Cursor) return Cursor
+ is
+ begin
+
+ return Previous (Object.Container.all, Position);
+ end Previous;
+
-------------------
-- Query_Element --
-------------------
@@ -1196,6 +1368,21 @@
raise Program_Error with "attempt to stream list cursor";
end Read;
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Constant_Reference (Container : List; Position : Cursor)
+ return Constant_Reference_Type is
+ begin
+
+ if not Has_Element (Container, Position) then
+ raise Constraint_Error with "Position cursor has no element";
+ end if;
+
+ return (Element => Container.Nodes (Position.Node).Element'Access);
+ end Constant_Reference;
+
---------------------
-- Replace_Element --
---------------------
===================================================================
@@ -53,6 +53,7 @@
private with Ada.Streams;
with Ada.Containers;
+with Ada.Iterator_Interfaces;
generic
type Element_Type is private;
@@ -63,7 +64,10 @@
package Ada.Containers.Formal_Doubly_Linked_Lists is
pragma Pure;
- type List (Capacity : Count_Type) is tagged private;
+ type List (Capacity : Count_Type) is tagged private with
+ Constant_Indexing => Constant_Reference,
+ Default_Iterator => Iterate,
+ Iterator_Element => Element_Type;
-- pragma Preelaborable_Initialization (List);
type Cursor is private;
@@ -73,6 +77,17 @@
No_Element : constant Cursor;
+ function Not_No_Element (Position : Cursor) return Boolean;
+
+ package List_Iterator_Interfaces is new
+ Ada.Iterator_Interfaces (Cursor => Cursor, Has_Element => Not_No_Element);
+
+ function Iterate (Container : List; Start : Cursor)
+ return List_Iterator_Interfaces.Reversible_Iterator'Class;
+
+ function Iterate (Container : List)
+ return List_Iterator_Interfaces.Reversible_Iterator'Class;
+
function "=" (Left, Right : List) return Boolean;
function Length (Container : List) return Count_Type;
@@ -225,6 +240,15 @@
end Generic_Sorting;
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is private
+ with
+ Implicit_Dereference => Element;
+
+ function Constant_Reference
+ (Container : List; Position : Cursor) -- SHOULD BE ALIASED
+ return Constant_Reference_Type;
+
function Strict_Equal (Left, Right : List) return Boolean;
-- Strict_Equal returns True if the containers are physically equal, i.e.
-- they are structurally equal (function "=" returns True) and that they
@@ -244,8 +268,9 @@
type Node_Type is record
Prev : Count_Type'Base := -1;
Next : Count_Type;
- Element : Element_Type;
+ Element : aliased Element_Type;
end record;
+
function "=" (L, R : Node_Type) return Boolean is abstract;
type Node_Array is array (Count_Type range <>) of Node_Type;
@@ -275,6 +300,9 @@
for List'Write use Write;
+ type List_Access is access all List;
+ for List_Access'Storage_Size use 0;
+
type Cursor is record
Node : Count_Type := 0;
end record;
@@ -295,4 +323,7 @@
No_Element : constant Cursor := (Node => 0);
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is null record;
+
end Ada.Containers.Formal_Doubly_Linked_Lists;
This patch allows the use of generic iteration on formal lists. If L is a formal list of integers, the following loop is now accepted: for C of L loop Put_Line ("Value =>" & C'Img); end loop; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-12-21 Claire Dross <dross@adacore.com> * a-cfdlli.ads (Constant_Indexing, Default_Iterator, Iterator_Element): Added to type List. (Not_No_Element, List_Iterator_Interfaces, Iterate, Constant_Reference_Type, Constant_Reference): New. * a-cfdlli.adb (type Iterator, Finalize, First, Last, Next, Previous, Iterate, Not_No_Element, Constant_Reference): New.