-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
pragma Elaborate_All
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
-with System; use type System.Address;
+with Ada.Finalization; use Ada.Finalization;
+
+with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Maps is
- type Iterator is new
- Map_Iterator_Interfaces.Reversible_Iterator with record
- Container : Map_Access;
- Node : Count_Type;
- end record;
+ type Iterator is new Limited_Controlled and
+ Map_Iterator_Interfaces.Reversible_Iterator with
+ record
+ Container : Map_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;
declare
LN : Node_Type renames Left.Container.Nodes (Left.Node);
-
begin
return Right < LN.Key;
end;
function Element (Container : Map; Key : Key_Type) return Element_Type is
Node : constant Count_Type := Key_Ops.Find (Container, Key);
-
begin
if Node = 0 then
raise Constraint_Error with "key not in map";
+ else
+ return Container.Nodes (Node).Element;
end if;
-
- return Container.Nodes (Node).Element;
end Element;
---------------------
end if;
end Exclude;
+ --------------
+ -- 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 --
----------
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;
-----------
begin
if Container.First = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.First);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.First);
end First;
function First (Object : Iterator) return Cursor is
- F : constant Count_Type := Object.Container.First;
begin
- if F = 0 then
- return No_Element;
- end if;
+ -- The value of the iterator object's Node component influences the
+ -- behavior of the First (and Last) selector function.
- return
- Cursor'(Object.Container.all'Unchecked_Access, F);
+ -- When the Node component is 0, 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 positive, 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 Bounded_Ordered_Maps.First (Object.Container.all);
+ else
+ return Cursor'(Object.Container, Object.Node);
+ end if;
end First;
-------------------
begin
if Container.First = 0 then
raise Constraint_Error with "map is empty";
+ else
+ return Container.Nodes (Container.First).Element;
end if;
-
- return Container.Nodes (Container.First).Element;
end First_Element;
---------------
begin
if Container.First = 0 then
raise Constraint_Error with "map is empty";
+ else
+ return Container.Nodes (Container.First).Key;
end if;
-
- return Container.Nodes (Container.First).Key;
end First_Key;
-----------
function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Floor (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 Floor;
-----------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
-
begin
N.Key := Key;
N.Element := New_Item;
function New_Node return Count_Type is
Result : Count_Type;
-
begin
Allocate (Container, Result);
return Result;
procedure Assign (Node : in out Node_Type) is
begin
Node.Key := Key;
+
+ -- Were this insertion operation to accept an element parameter, this
+ -- is the point where the element value would be used, to update the
+ -- element component of the new node. However, this insertion
+ -- operation is special, in the sense that it does not accept an
+ -- element parameter. Rather, this version of Insert allocates a node
+ -- (inserting it among the active nodes of the container in the
+ -- normal way, with the node's position being determined by the Key),
+ -- and passes back a cursor designating the node. It is then up to
+ -- the caller to assign a value to the node's element.
+
-- Node.Element := New_Item;
end Assign;
function New_Node return Count_Type is
Result : Count_Type;
-
begin
Allocate (Container, Result);
return Result;
Right : Node_Type) return Boolean
is
begin
- -- k > node same as node < k
+ -- Left > Right same as Right < Left
return Right.Key < Left;
end Is_Greater_Key_Node;
end Iterate;
function Iterate
- (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class
+ (Container : Map) return Map_Iterator_Interfaces.Reversible_Iterator'Class
is
- It : constant Iterator :=
- (Container'Unrestricted_Access, Container.First);
+ B : Natural renames Container'Unrestricted_Access.all.Busy;
+
begin
- return It;
+ -- 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 0 (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
+ Container => Container'Unrestricted_Access,
+ Node => 0)
+ do
+ B := B + 1;
+ end return;
end Iterate;
- function Iterate (Container : Map; Start : Cursor)
- return Map_Iterator_Interfaces.Reversible_Iterator'class
+ function Iterate
+ (Container : Map;
+ Start : Cursor)
+ return Map_Iterator_Interfaces.Reversible_Iterator'Class
is
- It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
+ B : Natural renames Container'Unrestricted_Access.all.Busy;
+
begin
- return It;
+ -- 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 map";
+ end if;
+
+ pragma Assert (Vet (Container, 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 positive (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
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
+ do
+ B := B + 1;
+ end return;
end Iterate;
---------
begin
if Container.Last = 0 then
return No_Element;
+ else
+ return Cursor'(Container'Unrestricted_Access, Container.Last);
end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Last);
end Last;
function Last (Object : Iterator) return Cursor is
- F : constant Count_Type := Object.Container.Last;
begin
- if F = 0 then
- return No_Element;
- end if;
+ -- The value of the iterator object's Node component influences the
+ -- behavior of the Last (and First) selector function.
+
+ -- When the Node component is 0, 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).
- return
- Cursor'(Object.Container.all'Unchecked_Access, F);
+ -- Otherwise, this is iteration over a partial sequence of items. When
+ -- the Node component is positive, 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 Bounded_Ordered_Maps.Last (Object.Container.all);
+ else
+ return Cursor'(Object.Container, Object.Node);
+ end if;
end Last;
------------------
begin
if Container.Last = 0 then
raise Constraint_Error with "map is empty";
+ else
+ return Container.Nodes (Container.Last).Element;
end if;
-
- return Container.Nodes (Container.Last).Element;
end Last_Element;
--------------
begin
if Container.Last = 0 then
raise Constraint_Error with "map is empty";
+ else
+ return Container.Nodes (Container.Last).Key;
end if;
-
- return Container.Nodes (Container.Last).Key;
end Last_Key;
----------
"attempt to tamper with cursors (container is busy)";
end if;
- Assign (Target => Target, Source => Source);
+ Target.Assign (Source);
+ Source.Clear;
end Move;
----------
(Object : Iterator;
Position : Cursor) return Cursor
is
- pragma Unreferenced (Object);
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 map";
+ end if;
+
return Next (Position);
end Next;
(Object : Iterator;
Position : Cursor) return Cursor
is
- pragma Unreferenced (Object);
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 map";
+ end if;
+
return Previous (Position);
end Previous;
-- Reference --
---------------
- function Constant_Reference (Container : Map; Key : Key_Type)
- return Constant_Reference_Type
+ function Constant_Reference
+ (Container : Map;
+ Key : Key_Type) return Constant_Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
- function Reference (Container : Map; Key : Key_Type)
- return Reference_Type
+ function Reference
+ (Container : Map;
+ Key : Key_Type) return Reference_Type
is
begin
return (Element => Container.Element (Key)'Unrestricted_Access);
B : Natural renames Container'Unrestricted_Access.all.Busy;
- -- Start of processing for Reverse_Iterate
+ -- Start of processing for Reverse_Iterate
begin
B := B + 1;
OSDN Git Service
