+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.
+
+2011-12-02 Robert Dewar <dewar@adacore.com>
+
+ * a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
+ a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
+ a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
+ a-ciorma.adb, a-cobove.adb: Minor reformatting.
+
2011-12-01 Jakub Jelinek <jakub@redhat.com>
PR bootstrap/51201
------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Doubly_Linked_Lists is
if Container.Free >= 0 then
New_Node := Container.Free;
- -- We always perform the assignment first, before we
- -- change container state, in order to defend against
- -- exceptions duration assignment.
+ -- We always perform the assignment first, before we change container
+ -- state, in order to defend against exceptions duration assignment.
N (New_Node).Element := New_Item;
Container.Free := N (New_Node).Next;
else
- -- A negative free store value means that the links of the nodes
- -- in the free store have not been initialized. In this case, the
- -- nodes are physically contiguous in the array, starting at the
- -- index that is the absolute value of the Container.Free, and
- -- continuing until the end of the array (Nodes'Last).
+ -- A negative free store value means that the links of the nodes in
+ -- the free store have not been initialized. In this case, the nodes
+ -- are physically contiguous in the array, starting at the index that
+ -- is the absolute value of the Container.Free, and continuing until
+ -- the end of the array (Nodes'Last).
New_Node := abs Container.Free;
- -- As above, we perform this assignment first, before modifying
- -- any container state.
+ -- As above, we perform this assignment first, before modifying any
+ -- container state.
N (New_Node).Element := New_Item;
Container.Free := Container.Free - 1;
if Container.Free >= 0 then
New_Node := Container.Free;
- -- We always perform the assignment first, before we
- -- change container state, in order to defend against
- -- exceptions duration assignment.
+ -- We always perform the assignment first, before we change container
+ -- state, in order to defend against exceptions duration assignment.
Element_Type'Read (Stream, N (New_Node).Element);
Container.Free := N (New_Node).Next;
else
- -- A negative free store value means that the links of the nodes
- -- in the free store have not been initialized. In this case, the
- -- nodes are physically contiguous in the array, starting at the
- -- index that is the absolute value of the Container.Free, and
- -- continuing until the end of the array (Nodes'Last).
+ -- A negative free store value means that the links of the nodes in
+ -- the free store have not been initialized. In this case, the nodes
+ -- are physically contiguous in the array, starting at the index that
+ -- is the absolute value of the Container.Free, and continuing until
+ -- the end of the array (Nodes'Last).
New_Node := abs Container.Free;
- -- As above, we perform this assignment first, before modifying
- -- any container state.
+ -- As above, we perform this assignment first, before modifying any
+ -- container state.
Element_Type'Read (Stream, N (New_Node).Element);
Container.Free := Container.Free - 1;
-- inactive immediately precedes the start of the free store. All
-- we need to do is move the start of the free store back by one.
- N (X).Next := 0; -- not strictly necessary, but marginally safer
+ -- Note: initializing Next to zero is not strictly necessary but
+ -- seems cleaner and marginally safer.
+
+ N (X).Next := 0;
Container.Free := Container.Free + 1;
else
if RN (RI.Node).Element < LN (LI.Node).Element then
declare
RJ : Cursor := RI;
- pragma Warnings (Off, RJ);
begin
RI.Node := RN (RI.Node).Next;
Splice (Target, LI, Source, RJ);
Container.Last := New_Node;
N (Container.Last).Next := 0;
- elsif Before = 0 then -- means append
+ -- Before = zero means append
+
+ elsif Before = 0 then
pragma Assert (N (Container.Last).Next = 0);
N (Container.Last).Next := New_Node;
Container.Last := New_Node;
N (Container.Last).Next := 0;
- elsif Before = Container.First then -- means prepend
+ -- Before = Container.First means prepend
+
+ elsif Before = Container.First then
pragma Assert (N (Container.First).Prev = 0);
N (Container.First).Prev := New_Node;
declare
L : List renames Position.Container.all;
N : Node_Array renames L.Nodes;
+
begin
if L.Length = 0 then
return False;
end if;
- if L.First = 0
- or L.First > L.Capacity
- then
+ if L.First = 0 or L.First > L.Capacity then
return False;
end if;
- if L.Last = 0
- or L.Last > L.Capacity
- then
+ if L.Last = 0 or L.Last > L.Capacity then
return False;
end if;
-- If we get here, we know that this disjunction is true:
-- N (Position.Node).Prev /= 0 or else Position.Node = L.First
+ -- Why not do this with an assertion???
if N (Position.Node).Next = 0
and then Position.Node /= L.Last
-- If we get here, we know that this disjunction is true:
-- N (Position.Node).Next /= 0 or else Position.Node = L.Last
+ -- Why not do this with an assertion???
if L.Length = 1 then
return L.First = L.Last;
return True;
end if;
- -- If we get here, we know (disjunctive syllogism) that this
- -- predicate is true: N (Position.Node).Prev /= 0
+ -- If we get to this point, we know that this predicate is true:
+ -- N (Position.Node).Prev /= 0
if Position.Node = L.Last then -- eliminates earlier disjunct
return True;
end if;
- -- If we get here, we know (disjunctive syllogism) that this
- -- predicate is true: N (Position.Node).Next /= 0
+ -- If we get to this point, we know that this predicate is true:
+ -- N (Position.Node).Next /= 0
if N (N (Position.Node).Next).Prev /= Position.Node then
return False;
with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Hashed_Maps is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
begin
if Node = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Node);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
end Find;
-----------
function First (Container : Map) return Cursor is
Node : constant Count_Type := HT_Ops.First (Container);
-
begin
if Node = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Node);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
end First;
function First (Object : Iterator) return Cursor is
declare
N : Node_Type renames Container.Nodes (Position.Node);
-
begin
N.Key := Key;
N.Element := New_Item;
-- parameter.
-- Node.Element := New_Item;
+ -- What is this deleted code about???
end Assign_Key;
--------------
declare
M : Map renames Position.Container.all;
Node : constant Count_Type := HT_Ops.Next (M, Position.Node);
-
begin
if Node = 0 then
return No_Element;
+ else
+ return Cursor'(Position.Container, Node);
end if;
-
- return Cursor'(Position.Container, Node);
end;
end Next;
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
return Set_Iterator_Interfaces.Forward_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.Busy;
-
begin
B := B + 1;
-
return It : constant Iterator :=
Iterator'(Limited_Controlled with
Container => Container'Unrestricted_Access);
------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Multiway_Trees is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Maps is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations);
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Sets is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
+
with System; use type System.Address;
package body Ada.Containers.Doubly_Linked_Lists is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
procedure Free (X : in out Node_Access) is
procedure Deallocate is
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
begin
X.Prev := X;
X.Next := X;
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
+
with System; use type System.Address;
package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
with Ada.Unchecked_Deallocation;
+
with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Maps is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.HT.Busy;
-
begin
B := B - 1;
end;
function First (Container : Map) return Cursor is
Node : constant Node_Access := HT_Ops.First (Container.HT);
-
begin
if Node = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Node);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
end First;
function First (Object : Iterator) return Cursor is
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
-
begin
return It : constant Iterator :=
(Limited_Controlled with
declare
HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
-
begin
if Node = null then
return No_Element;
+ else
+ return Cursor'(Position.Container, Node);
end if;
-
- return Cursor'(Position.Container, Node);
end;
end Next;
pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
with Ada.Containers.Prime_Numbers;
+
with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Sets is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.HT.Busy;
-
begin
B := B - 1;
end;
return Set_Iterator_Interfaces.Forward_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
-
begin
return It : constant Iterator :=
Iterator'(Limited_Controlled with
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
+
with System; use type System.Address;
package body Ada.Containers.Indefinite_Multiway_Trees is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
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
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Tree.Busy;
-
begin
B := B - 1;
end;
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 --
-----------------------------
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 --
-----------
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 --
-------------------
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 --
----------
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 --
------------------
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 --
-------------
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 --
-------------------
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;
-- 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;
-- 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
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)
-- 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;
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
with Ada.Unchecked_Deallocation;
+
with System; use type System.Address;
package body Ada.Containers.Indefinite_Ordered_Sets is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Tree.Busy;
-
begin
B := B - 1;
end;
function Find (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
Element_Keys.Find (Container.Tree, Item);
-
begin
if Node = null then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Node);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
end Find;
-----------
function Element (Container : Set; Key : Key_Type) return Element_Type is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
-
begin
if Node = null then
raise Constraint_Error with "key not in set";
+ else
+ return Node.Element.all;
end if;
-
- return Node.Element.all;
end Element;
---------------------
with Ada.Containers.Generic_Array_Sort;
with Ada.Finalization; use Ada.Finalization;
+
with System; use type System.Address;
package body Ada.Containers.Bounded_Vectors is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
-
begin
B := B - 1;
end;
return Vector_Iterator_Interfaces.Reversible_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.Busy;
-
begin
return It : constant Iterator :=
Iterator'(Limited_Controlled with
return Vector_Iterator_Interfaces.Reversible_Iterator'class
is
B : Natural renames Container'Unrestricted_Access.all.Busy;
-
begin
return It : constant Iterator :=
Iterator'(Limited_Controlled with
"attempt to tamper with cursors (Source is busy)";
end if;
- -- Clear Target now, in case element assignment fails.
+ -- Clear Target now, in case element assignment fails
+
Target.Last := No_Index;
Target.Elements (1 .. Source.Length) :=
---------------
function Constant_Reference
- (Container : Vector; Position : Cursor) -- SHOULD BE ALIASED
- return Constant_Reference_Type is
+ (Container : Vector;
+ Position : Cursor) -- SHOULD BE ALIASED
+ return Constant_Reference_Type
+ is
begin
pragma Unreferenced (Container);
end Constant_Reference;
function Constant_Reference
- (Container : Vector; Position : Index_Type)
- return Constant_Reference_Type is
+ (Container : Vector;
+ Position : Index_Type)
+ return Constant_Reference_Type
+ is
begin
if (Position) > Container.Last then
raise Constraint_Error with "Index is out of range";
Container.Elements (To_Array_Index (Position))'Access);
end Constant_Reference;
- function Reference (Container : Vector; Position : Cursor)
- return Reference_Type is
+ function Reference
+ (Container : Vector;
+ Position : Cursor)
+ return Reference_Type
+ is
begin
pragma Unreferenced (Container);
(To_Array_Index (Position.Index))'Access);
end Reference;
- function Reference (Container : Vector; Position : Index_Type)
- return Reference_Type is
+ function Reference
+ (Container : Vector;
+ Position : Index_Type)
+ return Reference_Type
+ is
begin
if Position > Container.Last then
raise Constraint_Error with "Index is out of range";
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.HT.Busy;
-
begin
B := B - 1;
end;
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
-
begin
return It : constant Iterator :=
(Limited_Controlled with
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 --
-----------------------------
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 --
----------
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 --
-------------------
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 --
----------
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 --
------------------
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 --
-------------
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 --
-------------------
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;
-- 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;
-- 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
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)
-- 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;
OSDN Git Service
