Skip to content

R
riscv-gcc-1
Commit e47e21c1 by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r181912
parent 3e44f600
Showing with 485 additions and 98 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/a-cbdlli.adb
......@@ -28,6 +28,7 @@
------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address;
package body Ada.Containers.Bounded_Doubly_Linked_Lists is
......@@ -129,24 +130,23 @@ 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;
......@@ -164,24 +164,23 @@ 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.
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;
......@@ -674,7 +673,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- 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
......@@ -794,7 +796,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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);
......@@ -1035,7 +1036,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......@@ -1044,7 +1047,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......@@ -2129,20 +2134,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......@@ -2182,6 +2184,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- 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
......@@ -2191,6 +2194,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- 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;
......@@ -2242,15 +2246,15 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
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;
......
gcc/ada/a-cbhama.adb
......@@ -35,6 +35,7 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys);
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
......@@ -405,7 +406,6 @@ 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;
......@@ -418,13 +418,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
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;
-----------
......@@ -433,13 +432,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
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
......@@ -489,7 +487,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is
declare
N : Node_Type renames Container.Nodes (Position.Node);
begin
N.Key := Key;
N.Element := New_Item;
......@@ -532,6 +529,7 @@ package body Ada.Containers.Bounded_Hashed_Maps is
-- parameter.
-- Node.Element := New_Item;
-- What is this deleted code about???
end Assign_Key;
--------------
......@@ -768,13 +766,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
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;
......
gcc/ada/a-cbhase.adb
......@@ -583,7 +583,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Busy;
begin
B := B - 1;
end;
......@@ -930,10 +929,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
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);
......
gcc/ada/a-cbmutr.adb
......@@ -28,6 +28,7 @@
------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address;
package body Ada.Containers.Bounded_Multiway_Trees is
......@@ -1246,7 +1247,6 @@ 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;
......@@ -1258,7 +1258,6 @@ 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;
......
gcc/ada/a-cborma.adb
......@@ -36,6 +36,7 @@ pragma Elaborate_All
(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
......@@ -563,7 +564,6 @@ 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;
......
gcc/ada/a-cborse.adb
......@@ -39,6 +39,7 @@ pragma Elaborate_All
(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
......@@ -580,7 +581,6 @@ 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;
......
gcc/ada/a-cdlili.adb
......@@ -28,6 +28,7 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
package body Ada.Containers.Doubly_Linked_Lists is
......@@ -407,7 +408,6 @@ 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;
......@@ -504,7 +504,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
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;
......
gcc/ada/a-cidlli.adb
......@@ -28,6 +28,7 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
......@@ -440,7 +441,6 @@ 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;
......
gcc/ada/a-cihama.adb
......@@ -34,6 +34,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys;
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
......@@ -428,7 +429,6 @@ 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;
......@@ -479,13 +479,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
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
......@@ -726,7 +725,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps 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
......@@ -809,13 +807,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
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;
......
gcc/ada/a-cihase.adb
......@@ -36,6 +36,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys;
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
......@@ -576,7 +577,6 @@ 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;
......@@ -1024,7 +1024,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
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
......
gcc/ada/a-cimutr.adb
......@@ -28,6 +28,7 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with System; use type System.Address;
package body Ada.Containers.Indefinite_Multiway_Trees is
......@@ -940,7 +941,6 @@ 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;
......@@ -952,7 +952,6 @@ 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;
......@@ -1362,7 +1361,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
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
......
gcc/ada/a-ciorma.adb
......@@ -546,7 +546,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.Tree.Busy;
begin
B := B - 1;
end;
......
gcc/ada/a-ciormu.adb
......@@ -42,6 +42,26 @@ with System; use type System.Address;
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
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 --
-------------------
......
gcc/ada/a-ciormu.ads
......@@ -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 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- 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 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- 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 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
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 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- 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;
......
gcc/ada/a-ciorse.adb
......@@ -37,6 +37,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
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
......@@ -581,7 +582,6 @@ 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;
......@@ -595,13 +595,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
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;
-----------
......@@ -766,13 +765,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
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;
---------------------
......
gcc/ada/a-cobove.adb
......@@ -29,6 +29,7 @@
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
......@@ -670,7 +671,6 @@ 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;
......@@ -1649,7 +1649,6 @@ package body Ada.Containers.Bounded_Vectors is
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
......@@ -1666,7 +1665,6 @@ package body Ada.Containers.Bounded_Vectors is
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
......@@ -1783,7 +1781,8 @@ package body Ada.Containers.Bounded_Vectors is
"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) :=
......@@ -1992,8 +1991,10 @@ package body Ada.Containers.Bounded_Vectors is
---------------
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);
......@@ -2012,8 +2013,10 @@ package body Ada.Containers.Bounded_Vectors is
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";
......@@ -2023,8 +2026,11 @@ package body Ada.Containers.Bounded_Vectors is
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);
......@@ -2042,8 +2048,11 @@ package body Ada.Containers.Bounded_Vectors is
(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";
......
gcc/ada/a-cohama.adb
......@@ -393,7 +393,6 @@ package body Ada.Containers.Hashed_Maps is
if Object.Container /= null then
declare
B : Natural renames Object.Container.all.HT.Busy;
begin
B := B - 1;
end;
......@@ -678,7 +677,6 @@ package body Ada.Containers.Hashed_Maps 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
......
gcc/ada/a-coormu.adb
......@@ -42,6 +42,26 @@ with System; use type System.Address;
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 @@ package body Ada.Containers.Ordered_Multisets is
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 @@ package body Ada.Containers.Ordered_Multisets is
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 @@ package body Ada.Containers.Ordered_Multisets is
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 @@ package body Ada.Containers.Ordered_Multisets is
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 @@ package body Ada.Containers.Ordered_Multisets is
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 @@ package body Ada.Containers.Ordered_Multisets is
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 --
-------------------
......
gcc/ada/a-coormu.ads
......@@ -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 @@ package Ada.Containers.Ordered_Multisets is
-- 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 @@ package Ada.Containers.Ordered_Multisets is
-- 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 @@ package Ada.Containers.Ordered_Multisets is
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 @@ package Ada.Containers.Ordered_Multisets is
-- 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;
......
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