Patchwork [Ada] Implement iterator for multiset containers

login
register
mail settings
Submitter Arnaud Charlet
Date Dec. 2, 2011, 2:37 p.m.
Message ID <20111202143730.GA19986@adacore.com>
Download mbox | patch
Permalink /patch/128875/
State New
Headers show

Comments

Arnaud Charlet - Dec. 2, 2011, 2:37 p.m.
This change implements a reversible iterator for multiset containers.

An iterator can either be partial, visiting only some of the items in the
container (in which case the start position is specified), or complete,
visiting all of them.  The iterator caches the start position during its
construction, and that position value is used by First and Last to determine
their associated return values.

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-12-02  Matthew Heaney  <heaney@adacore.com>

	* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
	* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
	Iterator type.
	(Finalize): Decrement busy counter.
	(First, Last): Cursor return value depends on iterator node value.
	(Iterate): Use start position as iterator node value.
	(Next, Previous): Forward to corresponding cursor-based operation.

Patch

Index: a-ciormu.adb
===================================================================
--- a-ciormu.adb	(revision 181910)
+++ a-ciormu.adb	(working copy)
@@ -42,6 +42,26 @@ 
 
 package body Ada.Containers.Indefinite_Ordered_Multisets is
 
+   type Iterator is new Limited_Controlled and
+     Set_Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : Set_Access;
+      Node      : Node_Access;
+   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;
+
    -----------------------------
    -- Node Access Subprograms --
    -----------------------------
@@ -592,6 +612,17 @@ 
       return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Tree.Busy;
+      pragma Assert (B > 0);
+   begin
+      B := B - 1;
+   end Finalize;
+
    -----------
    -- First --
    -----------
@@ -605,6 +636,28 @@ 
       return Cursor'(Container'Unrestricted_Access, Container.Tree.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 = null then
+         return Object.Container.First;
+      else
+         return Cursor'(Object.Container, Object.Node);
+      end if;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -1347,6 +1400,75 @@ 
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Set)
+     return Set_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+      S : constant Set_Access := Container'Unrestricted_Access;
+      B : Natural renames S.Tree.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 := (Limited_Controlled with S, null) do
+         B := B + 1;
+      end return;
+   end Iterate;
+
+   function Iterate (Container : Set; Start : Cursor)
+     return Set_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+      S : constant Set_Access := Container'Unrestricted_Access;
+      B : Natural renames S.Tree.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 Start = No_Element then
+         raise Constraint_Error with
+           "Start position for iterator equals No_Element";
+      end if;
+
+      if Start.Container /= Container'Unrestricted_Access then
+         raise Program_Error with
+           "Start cursor of Iterate designates wrong set";
+      end if;
+
+      pragma Assert (Vet (Container.Tree, Start.Node),
+                     "Start cursor of Iterate is bad");
+
+      --  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 :=
+                    (Limited_Controlled with S, Start.Node)
+      do
+         B := B + 1;
+      end return;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1360,6 +1482,28 @@ 
       return Cursor'(Container'Unrestricted_Access, Container.Tree.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 = null then
+         return Object.Container.Last;
+      else
+         return Cursor'(Object.Container, Object.Node);
+      end if;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -1435,6 +1579,20 @@ 
       Position := Next (Position);
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong set";
+      end if;
+
+      return Next (Position);
+   end Next;
+
    -------------
    -- Overlap --
    -------------
@@ -1484,6 +1642,20 @@ 
       Position := Previous (Position);
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong set";
+      end if;
+
+      return Previous (Position);
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
Index: a-ciormu.ads
===================================================================
--- a-ciormu.ads	(revision 181910)
+++ a-ciormu.ads	(working copy)
@@ -35,6 +35,7 @@ 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
 private with Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Element_Type (<>) is private;
@@ -50,7 +51,10 @@ 
    --  Returns False if Left is less than Right, or Right is less than Left;
    --  otherwise, it returns True.
 
-   type Set is tagged private;
+   type Set is tagged private
+   with Default_Iterator => Iterate,
+        Iterator_Element => Element_Type;
+
    pragma Preelaborable_Initialization (Set);
 
    type Cursor is private;
@@ -64,6 +68,12 @@ 
    --  The default value for cursor objects declared without an explicit
    --  initialization expression.
 
+   function Has_Element (Position : Cursor) return Boolean;
+   --  Equivalent to Position /= No_Element
+
+   package Set_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Set) return Boolean;
    --  If Left denotes the same set object as Right, then equality returns
    --  True. If the length of Left is different from the length of Right, then
@@ -286,9 +296,6 @@ 
    function Contains (Container : Set; Item : Element_Type) return Boolean;
    --  Equivalent to Container.Find (Item) /= No_Element
 
-   function Has_Element (Position : Cursor) return Boolean;
-   --  Equivalent to Position /= No_Element
-
    function "<" (Left, Right : Cursor) return Boolean;
    --  Equivalent to Element (Left) < Element (Right)
 
@@ -333,6 +340,15 @@ 
    --  Call Process with a cursor designating each element equivalent to Item,
    --  in order from Container.Ceiling (Item) to Container.Floor (Item).
 
+   function Iterate
+     (Container : Set)
+      return Set_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : Set;
+      Start     : Cursor)
+      return Set_Iterator_Interfaces.Reversible_Iterator'class;
+
    generic
       type Key_Type (<>) is private;
 
Index: a-coormu.adb
===================================================================
--- a-coormu.adb	(revision 181910)
+++ a-coormu.adb	(working copy)
@@ -42,6 +42,26 @@ 
 
 package body Ada.Containers.Ordered_Multisets is
 
+   type Iterator is new Limited_Controlled and
+     Set_Iterator_Interfaces.Reversible_Iterator with
+   record
+      Container : Set_Access;
+      Node      : Node_Access;
+   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;
+
    -----------------------------
    -- Node Access Subprograms --
    -----------------------------
@@ -531,6 +551,17 @@ 
       end loop;
    end Exclude;
 
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (Object : in out Iterator) is
+      B : Natural renames Object.Container.Tree.Busy;
+      pragma Assert (B > 0);
+   begin
+      B := B - 1;
+   end Finalize;
+
    ----------
    -- Find --
    ----------
@@ -560,6 +591,28 @@ 
       return Cursor'(Container'Unrestricted_Access, Container.Tree.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 = null then
+         return Object.Container.First;
+      else
+         return Cursor'(Object.Container, Object.Node);
+      end if;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -1269,6 +1322,75 @@ 
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Set)
+     return Set_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+      S : constant Set_Access := Container'Unrestricted_Access;
+      B : Natural renames S.Tree.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 := (Limited_Controlled with S, null) do
+         B := B + 1;
+      end return;
+   end Iterate;
+
+   function Iterate (Container : Set; Start : Cursor)
+     return Set_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+      S : constant Set_Access := Container'Unrestricted_Access;
+      B : Natural renames S.Tree.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 Start = No_Element then
+         raise Constraint_Error with
+           "Start position for iterator equals No_Element";
+      end if;
+
+      if Start.Container /= Container'Unrestricted_Access then
+         raise Program_Error with
+           "Start cursor of Iterate designates wrong set";
+      end if;
+
+      pragma Assert (Vet (Container.Tree, Start.Node),
+                     "Start cursor of Iterate is bad");
+
+      --  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 :=
+                    (Limited_Controlled with S, Start.Node)
+      do
+         B := B + 1;
+      end return;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1282,6 +1404,28 @@ 
       return Cursor'(Container'Unrestricted_Access, Container.Tree.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 = null then
+         return Object.Container.Last;
+      else
+         return Cursor'(Object.Container, Object.Node);
+      end if;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -1356,6 +1500,20 @@ 
       end;
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong set";
+      end if;
+
+      return Next (Position);
+   end Next;
+
    -------------
    -- Overlap --
    -------------
@@ -1405,6 +1563,20 @@ 
       end;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor is
+   begin
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Previous designates wrong set";
+      end if;
+
+      return Previous (Position);
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
Index: a-coormu.ads
===================================================================
--- a-coormu.ads	(revision 181910)
+++ a-coormu.ads	(working copy)
@@ -34,6 +34,7 @@ 
 private with Ada.Containers.Red_Black_Trees;
 private with Ada.Finalization;
 private with Ada.Streams;
+with Ada.Iterator_Interfaces;
 
 generic
    type Element_Type is private;
@@ -49,7 +50,10 @@ 
    --  Returns False if Left is less than Right, or Right is less than Left;
    --  otherwise, it returns True.
 
-   type Set is tagged private;
+   type Set is tagged private
+   with Default_Iterator => Iterate,
+        Iterator_Element => Element_Type;
+
    pragma Preelaborable_Initialization (Set);
 
    type Cursor is private;
@@ -63,6 +67,12 @@ 
    --  The default value for cursor objects declared without an explicit
    --  initialization expression.
 
+   function Has_Element (Position : Cursor) return Boolean;
+   --  Equivalent to Position /= No_Element
+
+   package Set_Iterator_Interfaces is new
+     Ada.Iterator_Interfaces (Cursor, Has_Element);
+
    function "=" (Left, Right : Set) return Boolean;
    --  If Left denotes the same set object as Right, then equality returns
    --  True. If the length of Left is different from the length of Right, then
@@ -293,9 +303,6 @@ 
    function Contains (Container : Set; Item : Element_Type) return Boolean;
    --  Equivalent to Container.Find (Item) /= No_Element
 
-   function Has_Element (Position : Cursor) return Boolean;
-   --  Equivalent to Position /= No_Element
-
    function "<" (Left, Right : Cursor) return Boolean;
    --  Equivalent to Element (Left) < Element (Right)
 
@@ -340,6 +347,15 @@ 
    --  Call Process with a cursor designating each element equivalent to Item,
    --  in order from Container.Ceiling (Item) to Container.Floor (Item).
 
+   function Iterate
+     (Container : Set)
+      return Set_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate
+     (Container : Set;
+      Start     : Cursor)
+      return Set_Iterator_Interfaces.Reversible_Iterator'class;
+
    generic
       type Key_Type (<>) is private;