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 <dr...@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.
Index: a-cfdlli.adb =================================================================== --- a-cfdlli.adb (revision 182572) +++ a-cfdlli.adb (working copy) @@ -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 -- --------------------- Index: a-cfdlli.ads =================================================================== --- a-cfdlli.ads (revision 182572) +++ a-cfdlli.ads (working copy) @@ -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;