a-crbtgo.ads, [...]: Compiles against the spec for ordered maps described in sections A.18.6 of the...
2005-11-14 Matthew Heaney <heaney@adacore.com> * a-crbtgo.ads, a-crbtgo.adb, a-coorse.ads, a-coorse.adb, a-convec.ads, a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohama.ads, a-cohama.adb, a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb, a-cidlli.ads, a-cidlli.adb, a-cdlili.ads, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cihase.ads, a-cohase.adb, a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads, a-ciorma.adb, a-coorma.adb: Compiles against the spec for ordered maps described in sections A.18.6 of the most recent (August 2005) AI-302 draft. From-SVN: r106962
This commit is contained in:
Matthew Heaney
Arnaud Charlet
parent
5e61ef090a
commit
2368f04ec1
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -34,6 +34,7 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
with System; use type System.Address;
|
||||
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body Ada.Containers.Doubly_Linked_Lists is
|
||||
|
|
@ -129,7 +130,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
procedure Append
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1) is
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
begin
|
||||
Insert (Container, No_Element, New_Item, Count);
|
||||
end Append;
|
||||
|
|
@ -185,7 +187,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean is
|
||||
Item : Element_Type) return Boolean
|
||||
is
|
||||
begin
|
||||
return Find (Container, Item) /= No_Element;
|
||||
end Contains;
|
||||
|
|
@ -202,8 +205,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
X : Node_Access;
|
||||
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Delete");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
|
@ -212,13 +213,16 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Delete");
|
||||
|
||||
if Position.Node = Container.First then
|
||||
Delete_First (Container, Count);
|
||||
Position := First (Container);
|
||||
Position := No_Element; -- Post-York behavior
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Count = 0 then
|
||||
Position := No_Element; -- Post-York behavior
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
@ -247,6 +251,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
Free (X);
|
||||
end loop;
|
||||
|
||||
Position := No_Element; -- Post-York behavior
|
||||
end Delete;
|
||||
|
||||
------------------
|
||||
|
|
@ -329,12 +335,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Element");
|
||||
|
||||
return Position.Node.Element;
|
||||
end Element;
|
||||
|
||||
|
|
@ -354,11 +360,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
Node := Container.First;
|
||||
|
||||
else
|
||||
pragma Assert (Vet (Position), "bad cursor in Find");
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Find");
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
|
|
@ -604,12 +610,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
New_Node : Node_Access;
|
||||
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Container'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
end if;
|
||||
|
||||
if Count = 0 then
|
||||
|
|
@ -656,12 +662,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
New_Node : Node_Access;
|
||||
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Container'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
end if;
|
||||
|
||||
if Count = 0 then
|
||||
|
|
@ -937,12 +943,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
Process : not null access procedure (Element : in Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Query_Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
C : List renames Position.Container.all'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
|
@ -1018,97 +1024,46 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
end loop;
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type)
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container.Lock > 0 then
|
||||
if Position.Container /= Container'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Position.Node.Element := By;
|
||||
end Replace_Element;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
|
||||
function Reverse_Find
|
||||
(Container : List;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
Node : Node_Access := Position.Node;
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
Node := Container.Last;
|
||||
|
||||
else
|
||||
pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
if Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
if Node.Element = Item then
|
||||
return Cursor'(Container'Unchecked_Access, Node);
|
||||
end if;
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
Position.Node.Element := New_Item;
|
||||
end Replace_Element;
|
||||
|
||||
return No_Element;
|
||||
end Reverse_Find;
|
||||
----------------------
|
||||
-- Reverse_Elements --
|
||||
----------------------
|
||||
|
||||
---------------------
|
||||
-- Reverse_Iterate --
|
||||
---------------------
|
||||
|
||||
procedure Reverse_Iterate
|
||||
(Container : List;
|
||||
Process : not null access procedure (Position : Cursor))
|
||||
is
|
||||
C : List renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
||||
Node : Node_Access := Container.Last;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
while Node /= null loop
|
||||
Process (Cursor'(Container'Unchecked_Access, Node));
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
exception
|
||||
when others =>
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
B := B - 1;
|
||||
end Reverse_Iterate;
|
||||
|
||||
------------------
|
||||
-- Reverse_List --
|
||||
------------------
|
||||
|
||||
procedure Reverse_List (Container : in out List) is
|
||||
procedure Reverse_Elements (Container : in out List) is
|
||||
I : Node_Access := Container.First;
|
||||
J : Node_Access := Container.Last;
|
||||
|
||||
|
|
@ -1152,7 +1107,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
end if;
|
||||
end Swap;
|
||||
|
||||
-- Start of processing for Reverse_List
|
||||
-- Start of processing for Reverse_Elements
|
||||
|
||||
begin
|
||||
if Container.Length <= 1 then
|
||||
|
|
@ -1188,7 +1143,72 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
pragma Assert (Container.First.Prev = null);
|
||||
pragma Assert (Container.Last.Next = null);
|
||||
end Reverse_List;
|
||||
end Reverse_Elements;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
|
||||
function Reverse_Find
|
||||
(Container : List;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
Node : Node_Access := Position.Node;
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
Node := Container.Last;
|
||||
|
||||
else
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
if Node.Element = Item then
|
||||
return Cursor'(Container'Unchecked_Access, Node);
|
||||
end if;
|
||||
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
|
||||
return No_Element;
|
||||
end Reverse_Find;
|
||||
|
||||
---------------------
|
||||
-- Reverse_Iterate --
|
||||
---------------------
|
||||
|
||||
procedure Reverse_Iterate
|
||||
(Container : List;
|
||||
Process : not null access procedure (Position : Cursor))
|
||||
is
|
||||
C : List renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
||||
Node : Node_Access := Container.Last;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
while Node /= null loop
|
||||
Process (Cursor'(Container'Unchecked_Access, Node));
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
|
||||
exception
|
||||
when others =>
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
B := B - 1;
|
||||
end Reverse_Iterate;
|
||||
|
||||
------------
|
||||
-- Splice --
|
||||
|
|
@ -1200,12 +1220,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
Source : in out List)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
pragma Assert (Vet (Before), "bad cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Target'Address = Source'Address
|
||||
|
|
@ -1274,13 +1294,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
Position : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Position.Node = null then
|
||||
|
|
@ -1291,6 +1310,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
|
||||
if Position.Node = Before.Node
|
||||
or else Position.Node.Next = Before.Node
|
||||
then
|
||||
|
|
@ -1378,13 +1399,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
return;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Position.Node = null then
|
||||
|
|
@ -1395,6 +1415,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
|
||||
if Target.Length = Count_Type'Last then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
|
@ -1474,18 +1496,20 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
-- Swap --
|
||||
----------
|
||||
|
||||
procedure Swap (I, J : Cursor) is
|
||||
procedure Swap
|
||||
(Container : in out List;
|
||||
I, J : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap");
|
||||
|
||||
if I.Node = null
|
||||
or else J.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if I.Container /= J.Container then
|
||||
if I.Container /= Container'Unchecked_Access
|
||||
or else J.Container /= Container'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
|
|
@ -1493,15 +1517,19 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
return;
|
||||
end if;
|
||||
|
||||
if I.Container.Lock > 0 then
|
||||
if Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap");
|
||||
|
||||
declare
|
||||
EI : Element_Type renames I.Node.Element;
|
||||
EJ : Element_Type renames J.Node.Element;
|
||||
|
||||
EI_Copy : constant Element_Type := EI;
|
||||
|
||||
begin
|
||||
EI := EJ;
|
||||
EJ := EI_Copy;
|
||||
|
|
@ -1514,11 +1542,9 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
procedure Swap_Links
|
||||
(Container : in out List;
|
||||
I, J : Cursor) is
|
||||
I, J : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
|
||||
|
||||
if I.Node = null
|
||||
or else J.Node = null
|
||||
then
|
||||
|
|
@ -1539,6 +1565,9 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
|
||||
|
||||
declare
|
||||
I_Next : constant Cursor := Next (I);
|
||||
|
||||
|
|
@ -1570,20 +1599,24 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
||||
declare
|
||||
C : List renames Position.Container.all'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
|
@ -1761,4 +1794,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
|
|||
end loop;
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Doubly_Linked_Lists;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -63,22 +63,43 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type);
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Move
|
||||
(Target : in out List;
|
||||
Source : in out List);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
New_Item : Element_Type;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Prepend
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
|
|
@ -89,25 +110,6 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
New_Item : Element_Type;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out List;
|
||||
Position : in out Cursor;
|
||||
|
|
@ -121,21 +123,11 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
(Container : in out List;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
procedure Reverse_Elements (Container : in out List);
|
||||
|
||||
function Is_Sorted (Container : List) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out List);
|
||||
|
||||
procedure Merge (Target, Source : in out List);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
procedure Reverse_List (Container : in out List);
|
||||
|
||||
procedure Swap (I, J : Cursor);
|
||||
procedure Swap
|
||||
(Container : in out List;
|
||||
I, J : Cursor);
|
||||
|
||||
procedure Swap_Links
|
||||
(Container : in out List;
|
||||
|
|
@ -149,13 +141,13 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
procedure Splice
|
||||
(Target : in out List;
|
||||
Before : Cursor;
|
||||
Position : Cursor);
|
||||
Source : in out List;
|
||||
Position : in out Cursor);
|
||||
|
||||
procedure Splice
|
||||
(Target : in out List;
|
||||
Before : Cursor;
|
||||
Source : in out List;
|
||||
Position : in out Cursor);
|
||||
Position : Cursor);
|
||||
|
||||
function First (Container : List) return Cursor;
|
||||
|
||||
|
|
@ -165,9 +157,13 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
|
||||
function Last_Element (Container : List) return Element_Type;
|
||||
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean;
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find
|
||||
(Container : List;
|
||||
|
|
@ -179,13 +175,9 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
|
|
@ -197,6 +189,18 @@ package Ada.Containers.Doubly_Linked_Lists is
|
|||
(Container : List;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
|
||||
function Is_Sorted (Container : List) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out List);
|
||||
|
||||
procedure Merge (Target, Source : in out List);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
private
|
||||
type Node_Type;
|
||||
type Node_Access is access Node_Type;
|
||||
|
|
@ -248,6 +252,18 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
end Ada.Containers.Doubly_Linked_Lists;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -211,7 +211,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean is
|
||||
Item : Element_Type) return Boolean
|
||||
is
|
||||
begin
|
||||
return Find (Container, Item) /= No_Element;
|
||||
end Contains;
|
||||
|
|
@ -228,23 +229,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
X : Node_Access;
|
||||
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Delete");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Delete");
|
||||
|
||||
if Position.Node = Container.First then
|
||||
Delete_First (Container, Count);
|
||||
Position := First (Container);
|
||||
Position := No_Element; -- Post-York behavior
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Count = 0 then
|
||||
Position := No_Element; -- Post-York behavior
|
||||
return;
|
||||
end if;
|
||||
|
||||
|
|
@ -273,6 +279,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
Free (X);
|
||||
end loop;
|
||||
|
||||
Position := No_Element; -- Post-York behavior
|
||||
end Delete;
|
||||
|
||||
------------------
|
||||
|
|
@ -355,12 +363,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Element");
|
||||
|
||||
return Position.Node.Element.all;
|
||||
end Element;
|
||||
|
||||
|
|
@ -380,11 +392,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Node := Container.First;
|
||||
|
||||
else
|
||||
pragma Assert (Vet (Position), "bad cursor in Find");
|
||||
if Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Find");
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
|
|
@ -635,12 +651,18 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
New_Node : Node_Access;
|
||||
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Container'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
if Before.Node = null
|
||||
or else Before.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad cursor in Insert");
|
||||
end if;
|
||||
|
||||
if Count = 0 then
|
||||
|
|
@ -942,12 +964,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Process : not null access procedure (Element : in Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Query_Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
C : List renames Position.Container.all'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
|
@ -1024,102 +1050,56 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
end loop;
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type)
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
declare
|
||||
X : Element_Access := Position.Node.Element;
|
||||
|
||||
begin
|
||||
Position.Node.Element := new Element_Type'(By);
|
||||
Position.Node.Element := new Element_Type'(New_Item);
|
||||
Free (X);
|
||||
end;
|
||||
end Replace_Element;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
----------------------
|
||||
-- Reverse_Elements --
|
||||
----------------------
|
||||
|
||||
function Reverse_Find
|
||||
(Container : List;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
Node : Node_Access := Position.Node;
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
Node := Container.Last;
|
||||
|
||||
else
|
||||
pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
if Node.Element.all = Item then
|
||||
return Cursor'(Container'Unchecked_Access, Node);
|
||||
end if;
|
||||
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
|
||||
return No_Element;
|
||||
end Reverse_Find;
|
||||
|
||||
---------------------
|
||||
-- Reverse_Iterate --
|
||||
---------------------
|
||||
|
||||
procedure Reverse_Iterate
|
||||
(Container : List;
|
||||
Process : not null access procedure (Position : in Cursor))
|
||||
is
|
||||
C : List renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
||||
Node : Node_Access := Container.Last;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
while Node /= null loop
|
||||
Process (Cursor'(Container'Unchecked_Access, Node));
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
exception
|
||||
when others =>
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
B := B - 1;
|
||||
end Reverse_Iterate;
|
||||
|
||||
------------------
|
||||
-- Reverse_List --
|
||||
------------------
|
||||
|
||||
procedure Reverse_List (Container : in out List) is
|
||||
procedure Reverse_Elements (Container : in out List) is
|
||||
I : Node_Access := Container.First;
|
||||
J : Node_Access := Container.Last;
|
||||
|
||||
|
|
@ -1163,7 +1143,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
end if;
|
||||
end Swap;
|
||||
|
||||
-- Start of processing for Reverse_List
|
||||
-- Start of processing for Reverse_Elements
|
||||
|
||||
begin
|
||||
if Container.Length <= 1 then
|
||||
|
|
@ -1199,7 +1179,75 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
pragma Assert (Container.First.Prev = null);
|
||||
pragma Assert (Container.Last.Next = null);
|
||||
end Reverse_List;
|
||||
end Reverse_Elements;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
|
||||
function Reverse_Find
|
||||
(Container : List;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
Node : Node_Access := Position.Node;
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
Node := Container.Last;
|
||||
|
||||
else
|
||||
if Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
|
||||
end if;
|
||||
|
||||
while Node /= null loop
|
||||
if Node.Element.all = Item then
|
||||
return Cursor'(Container'Unchecked_Access, Node);
|
||||
end if;
|
||||
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
|
||||
return No_Element;
|
||||
end Reverse_Find;
|
||||
|
||||
---------------------
|
||||
-- Reverse_Iterate --
|
||||
---------------------
|
||||
|
||||
procedure Reverse_Iterate
|
||||
(Container : List;
|
||||
Process : not null access procedure (Position : in Cursor))
|
||||
is
|
||||
C : List renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
|
||||
Node : Node_Access := Container.Last;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
while Node /= null loop
|
||||
Process (Cursor'(Container'Unchecked_Access, Node));
|
||||
Node := Node.Prev;
|
||||
end loop;
|
||||
exception
|
||||
when others =>
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
B := B - 1;
|
||||
end Reverse_Iterate;
|
||||
|
||||
------------
|
||||
-- Splice --
|
||||
|
|
@ -1211,12 +1259,18 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Source : in out List)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
if Before.Node = null
|
||||
or else Before.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Target'Address = Source'Address
|
||||
|
|
@ -1284,23 +1338,34 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Position : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
if Before.Node = null
|
||||
or else Before.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Target'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
|
||||
if Position.Node = Before.Node
|
||||
or else Position.Node.Next = Before.Node
|
||||
then
|
||||
|
|
@ -1388,23 +1453,34 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
return;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
if Before.Container /= null then
|
||||
if Before.Container /= Target'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Target'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
if Before.Node = null
|
||||
or else Before.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Before), "bad Before cursor in Splice");
|
||||
end if;
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Source'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad Position cursor in Splice");
|
||||
|
||||
if Target.Length = Count_Type'Last then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
|
@ -1484,18 +1560,20 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
-- Swap --
|
||||
----------
|
||||
|
||||
procedure Swap (I, J : Cursor) is
|
||||
procedure Swap
|
||||
(Container : in out List;
|
||||
I, J : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap");
|
||||
|
||||
if I.Node = null
|
||||
or else J.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if I.Container /= J.Container then
|
||||
if I.Container /= Container'Unchecked_Access
|
||||
or else J.Container /= Container'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
|
|
@ -1503,12 +1581,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
return;
|
||||
end if;
|
||||
|
||||
if I.Container.Lock > 0 then
|
||||
if Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap");
|
||||
|
||||
declare
|
||||
EI_Copy : constant Element_Access := I.Node.Element;
|
||||
|
||||
begin
|
||||
I.Node.Element := J.Node.Element;
|
||||
J.Node.Element := EI_Copy;
|
||||
|
|
@ -1524,9 +1606,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
I, J : Cursor)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
|
||||
|
||||
if I.Node = null
|
||||
or else J.Node = null
|
||||
then
|
||||
|
|
@ -1547,6 +1626,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
|
||||
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
|
||||
|
||||
declare
|
||||
I_Next : constant Cursor := Next (I);
|
||||
|
||||
|
|
@ -1580,20 +1662,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unchecked_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
||||
declare
|
||||
C : List renames Position.Container.all'Unrestricted_Access.all;
|
||||
B : Natural renames C.Busy;
|
||||
L : Natural renames C.Lock;
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
|
@ -1775,4 +1865,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
end loop;
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Indefinite_Doubly_Linked_Lists;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -62,35 +62,26 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
procedure Clear (Container : in out List);
|
||||
|
||||
function Element (Position : Cursor)
|
||||
return Element_Type;
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type);
|
||||
(Container : in out List;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Move
|
||||
(Target : in out List;
|
||||
Source : in out List);
|
||||
|
||||
procedure Prepend
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Append
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out List;
|
||||
Before : Cursor;
|
||||
|
|
@ -104,6 +95,16 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Prepend
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Append
|
||||
(Container : in out List;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out List;
|
||||
Position : in out Cursor;
|
||||
|
|
@ -117,21 +118,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
(Container : in out List;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
procedure Reverse_Elements (Container : in out List);
|
||||
|
||||
function Is_Sorted (Container : List) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out List);
|
||||
|
||||
procedure Merge (Target, Source : in out List);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
procedure Reverse_List (Container : in out List);
|
||||
|
||||
procedure Swap (I, J : Cursor);
|
||||
procedure Swap (Container : in out List; I, J : Cursor);
|
||||
|
||||
procedure Swap_Links (Container : in out List; I, J : Cursor);
|
||||
|
||||
|
|
@ -143,13 +132,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
procedure Splice
|
||||
(Target : in out List;
|
||||
Before : Cursor;
|
||||
Position : Cursor);
|
||||
Source : in out List;
|
||||
Position : in out Cursor);
|
||||
|
||||
procedure Splice
|
||||
(Target : in out List;
|
||||
Before : Cursor;
|
||||
Source : in out List;
|
||||
Position : in out Cursor);
|
||||
Position : Cursor);
|
||||
|
||||
function First (Container : List) return Cursor;
|
||||
|
||||
|
|
@ -159,9 +148,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
|
||||
function Last_Element (Container : List) return Element_Type;
|
||||
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean;
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find
|
||||
(Container : List;
|
||||
|
|
@ -173,13 +166,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
function Contains
|
||||
(Container : List;
|
||||
Item : Element_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
|
|
@ -191,6 +180,18 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
|
|||
(Container : List;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
|
||||
function Is_Sorted (Container : List) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out List);
|
||||
|
||||
procedure Merge (Target, Source : in out List);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
private
|
||||
type Node_Type;
|
||||
type Node_Access is access Node_Type;
|
||||
|
|
@ -244,6 +245,18 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
end Ada.Containers.Indefinite_Doubly_Linked_Lists;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -713,6 +713,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
Read_Nodes (Stream, Container.HT);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------
|
||||
-- Read_Node --
|
||||
---------------
|
||||
|
|
@ -787,7 +795,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
|
|
@ -795,6 +807,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container.HT.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
|
@ -803,7 +819,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
X : Element_Access := Position.Node.Element;
|
||||
|
||||
begin
|
||||
Position.Node.Element := new Element_Type'(By);
|
||||
Position.Node.Element := new Element_Type'(New_Item);
|
||||
Free_Element (X);
|
||||
end;
|
||||
end Replace_Element;
|
||||
|
|
@ -834,9 +850,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
|
@ -845,9 +862,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
declare
|
||||
M : Map renames Position.Container.all;
|
||||
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
|
||||
HT : Hash_Table_Type renames Container.HT;
|
||||
|
||||
B : Natural renames HT.Busy;
|
||||
L : Natural renames HT.Lock;
|
||||
|
|
@ -859,7 +879,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
declare
|
||||
K : Key_Type renames Position.Node.Key.all;
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
|
|
@ -951,6 +970,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
|
|||
Write_Nodes (Stream, Container.HT);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
----------------
|
||||
-- Write_Node --
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -57,6 +57,12 @@ package Ada.Containers.Indefinite_Hashed_Maps is
|
|||
|
||||
function "=" (Left, Right : Map) return Boolean;
|
||||
|
||||
function Capacity (Container : Map) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
(Container : in out Map;
|
||||
Capacity : Count_Type);
|
||||
|
||||
function Length (Container : Map) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Map) return Boolean;
|
||||
|
|
@ -67,20 +73,22 @@ package Ada.Containers.Indefinite_Hashed_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Move (Target : in out Map; Source : in out Map);
|
||||
|
||||
procedure Insert
|
||||
|
|
@ -105,29 +113,11 @@ package Ada.Containers.Indefinite_Hashed_Maps is
|
|||
Key : Key_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Map;
|
||||
Key : Key_Type);
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Map;
|
||||
Position : in out Cursor);
|
||||
procedure Delete (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Exclude
|
||||
(Container : in out Map;
|
||||
Key : Key_Type);
|
||||
|
||||
function Contains
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Boolean;
|
||||
|
||||
function Find
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Cursor;
|
||||
|
||||
function Element
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Element_Type;
|
||||
procedure Delete (Container : in out Map; Position : in out Cursor);
|
||||
|
||||
function First (Container : Map) return Cursor;
|
||||
|
||||
|
|
@ -135,29 +125,24 @@ package Ada.Containers.Indefinite_Hashed_Maps is
|
|||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
function Equivalent_Keys (Left, Right : Cursor)
|
||||
return Boolean;
|
||||
function Equivalent_Keys (Left, Right : Cursor) return Boolean;
|
||||
|
||||
function Equivalent_Keys
|
||||
(Left : Cursor;
|
||||
Right : Key_Type) return Boolean;
|
||||
function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
|
||||
|
||||
function Equivalent_Keys
|
||||
(Left : Key_Type;
|
||||
Right : Cursor) return Boolean;
|
||||
function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
|
||||
|
||||
procedure Iterate
|
||||
(Container : Map;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
function Capacity (Container : Map) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
(Container : in out Map;
|
||||
Capacity : Count_Type);
|
||||
|
||||
private
|
||||
pragma Inline ("=");
|
||||
pragma Inline (Length);
|
||||
|
|
@ -194,6 +179,7 @@ private
|
|||
|
||||
use HT_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
procedure Adjust (Container : in out Map);
|
||||
|
||||
|
|
@ -208,12 +194,22 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor :=
|
||||
(Container => null,
|
||||
Node => null);
|
||||
|
||||
use Ada.Streams;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Container : Map);
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -73,6 +73,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
function Hash_Node (Node : Node_Access) return Hash_Type;
|
||||
pragma Inline (Hash_Node);
|
||||
|
||||
procedure Insert
|
||||
(HT : in out Hash_Table_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean);
|
||||
|
||||
function Is_In (HT : Hash_Table_Type; Key : Node_Access) return Boolean;
|
||||
pragma Inline (Is_In);
|
||||
|
||||
|
|
@ -326,13 +332,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
begin
|
||||
if not Is_In (Right.HT, L_Node) then
|
||||
declare
|
||||
Indx : constant Hash_Type :=
|
||||
Hash (L_Node.Element.all) mod Buckets'Length;
|
||||
|
||||
Src : Element_Type renames L_Node.Element.all;
|
||||
Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
|
||||
Bucket : Node_Access renames Buckets (Indx);
|
||||
|
||||
Tgt : Element_Access := new Element_Type'(Src);
|
||||
begin
|
||||
Bucket := new Node_Type'(L_Node.Element, Bucket);
|
||||
Bucket := new Node_Type'(Tgt, Bucket);
|
||||
exception
|
||||
when others =>
|
||||
Free_Element (Tgt);
|
||||
raise;
|
||||
end;
|
||||
|
||||
Length := Length + 1;
|
||||
|
|
@ -643,6 +652,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
New_Item : Element_Type;
|
||||
Position : out Cursor;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
begin
|
||||
Insert (Container.HT, New_Item, Position.Node, Inserted);
|
||||
Position.Container := Container'Unchecked_Access;
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Set;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
Position : Cursor;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert (Container, New_Item, Position, Inserted);
|
||||
|
||||
if not Inserted then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(HT : in out Hash_Table_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node (Next : Node_Access) return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
|
@ -665,8 +700,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
raise;
|
||||
end New_Node;
|
||||
|
||||
HT : Hash_Table_Type renames Container.HT;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
||||
begin
|
||||
|
|
@ -674,30 +707,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
HT_Ops.Reserve_Capacity (HT, 1);
|
||||
end if;
|
||||
|
||||
Local_Insert (HT, New_Item, Position.Node, Inserted);
|
||||
Local_Insert (HT, New_Item, Node, Inserted);
|
||||
|
||||
if Inserted
|
||||
and then HT.Length > HT_Ops.Capacity (HT)
|
||||
then
|
||||
HT_Ops.Reserve_Capacity (HT, HT.Length);
|
||||
end if;
|
||||
|
||||
Position.Container := Container'Unchecked_Access;
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Set;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
Position : Cursor;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert (Container, New_Item, Position, Inserted);
|
||||
|
||||
if not Inserted then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
end Insert;
|
||||
|
||||
------------------
|
||||
|
|
@ -787,13 +803,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
begin
|
||||
if Is_In (Right.HT, L_Node) then
|
||||
declare
|
||||
Indx : constant Hash_Type :=
|
||||
Hash (L_Node.Element.all) mod Buckets'Length;
|
||||
Src : Element_Type renames L_Node.Element.all;
|
||||
|
||||
Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
|
||||
|
||||
Bucket : Node_Access renames Buckets (Indx);
|
||||
|
||||
Tgt : Element_Access := new Element_Type'(Src);
|
||||
|
||||
begin
|
||||
Bucket := new Node_Type'(L_Node.Element, Bucket);
|
||||
Bucket := new Node_Type'(Tgt, Bucket);
|
||||
exception
|
||||
when others =>
|
||||
Free_Element (Tgt);
|
||||
raise;
|
||||
end;
|
||||
|
||||
Length := Length + 1;
|
||||
|
|
@ -1040,6 +1063,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
Read_Nodes (Stream, Container.HT);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------
|
||||
-- Read_Node --
|
||||
---------------
|
||||
|
|
@ -1502,6 +1533,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
return (Controlled with HT => (Buckets, Length, 0, 0));
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
HT : Hash_Table_Type;
|
||||
Node : Node_Access;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert (HT, New_Item, Node, Inserted);
|
||||
return Set'(Controlled with HT);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1609,13 +1654,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
-------------
|
||||
|
||||
procedure Process (L_Node : Node_Access) is
|
||||
J : constant Hash_Type :=
|
||||
Hash (L_Node.Element.all) mod Buckets'Length;
|
||||
Src : Element_Type renames L_Node.Element.all;
|
||||
|
||||
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
|
||||
|
||||
Bucket : Node_Access renames Buckets (J);
|
||||
|
||||
Tgt : Element_Access := new Element_Type'(Src);
|
||||
|
||||
begin
|
||||
Bucket := new Node_Type'(L_Node.Element, Bucket);
|
||||
Bucket := new Node_Type'(Tgt, Bucket);
|
||||
exception
|
||||
when others =>
|
||||
Free_Element (Tgt);
|
||||
raise;
|
||||
end Process;
|
||||
|
||||
-- Start of processing for Process
|
||||
|
|
@ -1751,6 +1803,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
|||
Write_Nodes (Stream, Container.HT);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
----------------
|
||||
-- Write_Node --
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -63,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Sets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Capacity (Container : Set) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
|
|
@ -225,6 +227,7 @@ private
|
|||
|
||||
use HT_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -235,12 +238,22 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor :=
|
||||
(Container => null,
|
||||
Node => null);
|
||||
|
||||
use Ada.Streams;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Container : Set);
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -135,16 +135,56 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Key = null
|
||||
or else Right.Node.Key = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Key.all < Right.Node.Key.all;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Key = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Key.all < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Key = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Key.all;
|
||||
end "<";
|
||||
|
||||
|
|
@ -163,16 +203,56 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Key = null
|
||||
or else Right.Node.Key = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Key.all < Left.Node.Key.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Key = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Key.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Key = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Key.all < Left;
|
||||
end ">";
|
||||
|
||||
|
|
@ -194,12 +274,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Ceiling (Container : Map; Key : Key_Type) return Cursor is
|
||||
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
return No_Element;
|
||||
else
|
||||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end Ceiling;
|
||||
|
||||
-----------
|
||||
|
|
@ -268,11 +349,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Map_Access'(Container'Unrestricted_Access) then
|
||||
if Position.Node.Key = null
|
||||
or else Position.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Delete");
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
|
||||
Position.Container := null;
|
||||
|
|
@ -280,13 +370,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
procedure Delete (Container : in out Map; Key : Key_Type) is
|
||||
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if X = null then
|
||||
raise Constraint_Error;
|
||||
else
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end if;
|
||||
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end Delete;
|
||||
|
||||
------------------
|
||||
|
|
@ -295,6 +386,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
procedure Delete_First (Container : in out Map) is
|
||||
X : Node_Access := Container.Tree.First;
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
|
|
@ -308,6 +400,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
procedure Delete_Last (Container : in out Map) is
|
||||
X : Node_Access := Container.Tree.Last;
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
|
|
@ -321,15 +414,46 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element.all;
|
||||
end Element;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type is
|
||||
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Node.Element.all;
|
||||
end Element;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Keys --
|
||||
---------------------
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Keys;
|
||||
|
||||
-------------
|
||||
-- Exclude --
|
||||
-------------
|
||||
|
|
@ -339,7 +463,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
begin
|
||||
if X /= null then
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end if;
|
||||
end Exclude;
|
||||
|
|
@ -350,12 +474,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor is
|
||||
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||
|
||||
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;
|
||||
|
||||
-----------
|
||||
|
|
@ -363,12 +488,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
-----------
|
||||
|
||||
function First (Container : Map) return Cursor is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
if T.First = null then
|
||||
return No_Element;
|
||||
else
|
||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, T.First);
|
||||
end First;
|
||||
|
||||
-------------------
|
||||
|
|
@ -376,8 +503,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
-------------------
|
||||
|
||||
function First_Element (Container : Map) return Element_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.First.Element.all;
|
||||
if T.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.First.Element.all;
|
||||
end First_Element;
|
||||
|
||||
---------------
|
||||
|
|
@ -385,8 +518,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
---------------
|
||||
|
||||
function First_Key (Container : Map) return Key_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.First.Key.all;
|
||||
if T.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.First.Key.all;
|
||||
end First_Key;
|
||||
|
||||
-----------
|
||||
|
|
@ -395,12 +534,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Floor (Container : Map; Key : Key_Type) return Cursor is
|
||||
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
return No_Element;
|
||||
else
|
||||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end Floor;
|
||||
|
||||
----------
|
||||
|
|
@ -410,11 +550,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
procedure Free (X : in out Node_Access) is
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
begin
|
||||
if X = null then
|
||||
return;
|
||||
end if;
|
||||
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
begin
|
||||
Free_Key (X.Key);
|
||||
exception
|
||||
|
|
@ -664,6 +809,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Key = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Position.Node.Key.all;
|
||||
end Key;
|
||||
|
||||
|
|
@ -672,12 +828,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
----------
|
||||
|
||||
function Last (Container : Map) return Cursor is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
if T.Last = null then
|
||||
return No_Element;
|
||||
else
|
||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, T.Last);
|
||||
end Last;
|
||||
|
||||
------------------
|
||||
|
|
@ -685,8 +843,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
------------------
|
||||
|
||||
function Last_Element (Container : Map) return Element_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.Last.Element.all;
|
||||
if T.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.Last.Element.all;
|
||||
end Last_Element;
|
||||
|
||||
--------------
|
||||
|
|
@ -694,8 +858,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
--------------
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.Last.Key.all;
|
||||
if T.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.Last.Key.all;
|
||||
end Last_Key;
|
||||
|
||||
----------
|
||||
|
|
@ -738,8 +908,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Position.Node /= null);
|
||||
pragma Assert (Position.Node.Key /= null);
|
||||
pragma Assert (Position.Node.Element /= null);
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access := Tree_Operations.Next (Position.Node);
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
return No_Element;
|
||||
|
|
@ -773,9 +951,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Position.Node /= null);
|
||||
pragma Assert (Position.Node.Key /= null);
|
||||
pragma Assert (Position.Node.Element /= null);
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
return No_Element;
|
||||
|
|
@ -799,29 +984,46 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : Element_Type))
|
||||
is
|
||||
K : Key_Type renames Position.Node.Key.all;
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Key = null
|
||||
or else Position.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
declare
|
||||
K : Key_Type renames Position.Node.Key.all;
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -863,6 +1065,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
-------------
|
||||
-- Replace --
|
||||
-------------
|
||||
|
|
@ -908,15 +1118,40 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
X : Element_Access := Position.Node.Element;
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Position.Container.Tree.Lock > 0 then
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Key = null
|
||||
or else Position.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Position.Node.Element := new Element_Type'(By);
|
||||
Free_Element (X);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Container.Tree.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
declare
|
||||
X : Element_Access := Position.Node.Element;
|
||||
|
||||
begin
|
||||
Position.Node.Element := new Element_Type'(New_Item);
|
||||
Free_Element (X);
|
||||
end;
|
||||
end Replace_Element;
|
||||
|
||||
---------------------
|
||||
|
|
@ -1010,33 +1245,55 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
is
|
||||
K : Key_Type renames Position.Node.Key.all;
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Key = null
|
||||
or else Position.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
declare
|
||||
K : Key_Type renames Position.Node.Key.all;
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Update_Element;
|
||||
|
||||
-----------
|
||||
|
|
@ -1074,4 +1331,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Indefinite_Ordered_Maps;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -40,16 +40,16 @@ with Ada.Streams;
|
|||
|
||||
generic
|
||||
type Key_Type (<>) is private;
|
||||
|
||||
type Element_Type (<>) is private;
|
||||
|
||||
with function "<" (Left, Right : Key_Type) return Boolean is <>;
|
||||
|
||||
with function "=" (Left, Right : Element_Type) return Boolean is <>;
|
||||
|
||||
package Ada.Containers.Indefinite_Ordered_Maps is
|
||||
pragma Preelaborate;
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
|
||||
|
||||
type Map is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -70,17 +70,21 @@ package Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type);
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type));
|
||||
|
||||
procedure Move (Target : in out Map; Source : in out Map);
|
||||
|
||||
|
|
@ -106,54 +110,28 @@ package Ada.Containers.Indefinite_Ordered_Maps is
|
|||
Key : Key_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Map;
|
||||
Key : Key_Type);
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Map;
|
||||
Position : in out Cursor);
|
||||
procedure Delete (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Map; Position : in out Cursor);
|
||||
|
||||
procedure Delete_First (Container : in out Map);
|
||||
|
||||
procedure Delete_Last (Container : in out Map);
|
||||
|
||||
procedure Exclude
|
||||
(Container : in out Map;
|
||||
Key : Key_Type);
|
||||
|
||||
function Contains
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Boolean;
|
||||
|
||||
function Find
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Cursor;
|
||||
|
||||
function Element
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Element_Type;
|
||||
|
||||
function Floor
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Cursor;
|
||||
|
||||
function Ceiling
|
||||
(Container : Map;
|
||||
Key : Key_Type) return Cursor;
|
||||
|
||||
function First (Container : Map) return Cursor;
|
||||
|
||||
function First_Key (Container : Map) return Key_Type;
|
||||
|
||||
function First_Element (Container : Map) return Element_Type;
|
||||
|
||||
function First_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Last (Container : Map) return Cursor;
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Last_Element (Container : Map) return Element_Type;
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
|
@ -162,6 +140,16 @@ package Ada.Containers.Indefinite_Ordered_Maps is
|
|||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type;
|
||||
|
||||
function Floor (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Ceiling (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
function "<" (Left, Right : Cursor) return Boolean;
|
||||
|
|
@ -216,8 +204,9 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Map_Access is access Map;
|
||||
type Map_Access is access all Map;
|
||||
for Map_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is record
|
||||
|
|
@ -225,9 +214,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -87,6 +87,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
procedure Free (X : in out Node_Access);
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access);
|
||||
|
||||
procedure Insert_With_Hint
|
||||
(Dst_Tree : in out Tree_Type;
|
||||
Dst_Hint : Node_Access;
|
||||
|
|
@ -157,16 +162,56 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null
|
||||
or else Right.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Element.all < Right.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Element.all < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
|
|
@ -183,20 +228,60 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
-- ">" --
|
||||
---------
|
||||
|
||||
function ">" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
return Right < Left.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null
|
||||
or else Right.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
-- L > R same as R < L
|
||||
|
||||
return Right.Node.Element.all < Left.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Element.all < Left;
|
||||
end ">";
|
||||
|
||||
|
|
@ -313,6 +398,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Delete");
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
|
||||
|
|
@ -375,9 +463,35 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element.all;
|
||||
end Element;
|
||||
|
||||
-------------------------
|
||||
-- Equivalent_Elements --
|
||||
-------------------------
|
||||
|
||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Elements;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Sets --
|
||||
---------------------
|
||||
|
|
@ -420,6 +534,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
Node : Node_Access := Element_Keys.Ceiling (Tree, Item);
|
||||
Done : constant Node_Access := Element_Keys.Upper_Bound (Tree, Item);
|
||||
X : Node_Access;
|
||||
|
||||
begin
|
||||
while Node /= Done loop
|
||||
X := Node;
|
||||
|
|
@ -464,6 +579,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function First_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Container.Tree.First.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.First.Element.all;
|
||||
end First_Element;
|
||||
|
||||
|
|
@ -490,11 +613,16 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
procedure Free (X : in out Node_Access) is
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
begin
|
||||
if X = null then
|
||||
return;
|
||||
end if;
|
||||
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
begin
|
||||
Free_Element (X.Element);
|
||||
exception
|
||||
|
|
@ -538,34 +666,6 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
Is_Less_Key_Node => Is_Less_Key_Node,
|
||||
Is_Greater_Key_Node => Is_Greater_Key_Node);
|
||||
|
||||
---------
|
||||
-- "<" --
|
||||
---------
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
return Left < Right.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
return Right > Left.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
---------
|
||||
-- ">" --
|
||||
---------
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
return Left > Right.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
return Right < Left.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
-------------
|
||||
-- Ceiling --
|
||||
-------------
|
||||
|
|
@ -621,11 +721,32 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
-------------
|
||||
|
||||
function Element (Container : Set; Key : Key_Type) return Element_Type is
|
||||
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
|
||||
Node : constant Node_Access :=
|
||||
Key_Keys.Find (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Node.Element.all;
|
||||
end Element;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Keys --
|
||||
---------------------
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Keys;
|
||||
|
||||
-------------
|
||||
-- Exclude --
|
||||
-------------
|
||||
|
|
@ -681,9 +802,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Is_Greater_Key_Node
|
||||
(Left : Key_Type;
|
||||
Right : Node_Access) return Boolean is
|
||||
Right : Node_Access) return Boolean
|
||||
is
|
||||
begin
|
||||
return Left > Right.Element.all;
|
||||
return Key (Right.Element.all) < Left;
|
||||
end Is_Greater_Key_Node;
|
||||
|
||||
----------------------
|
||||
|
|
@ -692,9 +814,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Is_Less_Key_Node
|
||||
(Left : Key_Type;
|
||||
Right : Node_Access) return Boolean is
|
||||
Right : Node_Access) return Boolean
|
||||
is
|
||||
begin
|
||||
return Left < Right.Element.all;
|
||||
return Left < Key (Right.Element.all);
|
||||
end Is_Less_Key_Node;
|
||||
|
||||
-------------
|
||||
|
|
@ -746,6 +869,17 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Key (Position.Node.Element.all);
|
||||
end Key;
|
||||
|
||||
|
|
@ -812,13 +946,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element_Preserving_Key");
|
||||
|
||||
declare
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
K : Key_Type renames Key (E);
|
||||
K : constant Key_Type := Key (E);
|
||||
|
||||
B : Natural renames Tree.Busy;
|
||||
L : Natural renames Tree.Lock;
|
||||
|
|
@ -839,11 +980,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
L := L - 1;
|
||||
B := B - 1;
|
||||
|
||||
if K < E
|
||||
or else K > E
|
||||
then
|
||||
null;
|
||||
else
|
||||
if Equivalent_Keys (Left => K, Right => Key (E)) then
|
||||
return;
|
||||
end if;
|
||||
end;
|
||||
|
|
@ -883,6 +1020,24 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
(Container : in out Set;
|
||||
New_Item : Element_Type;
|
||||
Position : out Cursor)
|
||||
is
|
||||
begin
|
||||
Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
New_Item,
|
||||
Position.Node);
|
||||
|
||||
Position.Container := Container'Unrestricted_Access;
|
||||
end Insert;
|
||||
|
||||
----------------------
|
||||
-- Insert_Sans_Hint --
|
||||
----------------------
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
|
@ -904,7 +1059,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
return new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Element => X);
|
||||
|
||||
exception
|
||||
|
|
@ -913,16 +1068,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
raise;
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
-- Start of processing for Insert_Sans_Hint
|
||||
|
||||
begin
|
||||
Unconditional_Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
(Tree,
|
||||
New_Item,
|
||||
Position.Node);
|
||||
|
||||
Position.Container := Container'Unrestricted_Access;
|
||||
end Insert;
|
||||
Node);
|
||||
end Insert_Sans_Hint;
|
||||
|
||||
----------------------
|
||||
-- Insert_With_Hint --
|
||||
|
|
@ -1156,6 +1309,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Last_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.Last.Element.all;
|
||||
end Last_Element;
|
||||
|
||||
|
|
@ -1199,6 +1356,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
|
@ -1245,6 +1405,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
|
@ -1271,29 +1434,40 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type))
|
||||
is
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
S : Set renames Position.Container.all;
|
||||
T : Tree_Type renames S.Tree'Unrestricted_Access.all;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
begin
|
||||
Process (Position.Node.Element.all);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -1334,6 +1508,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
|
@ -1382,6 +1564,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Element := new Element_Type'(Item); -- OK if fails
|
||||
Node.Color := Red_Black_Trees.Red;
|
||||
Node.Parent := null;
|
||||
Node.Left := null;
|
||||
Node.Right := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1403,22 +1590,27 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
end Replace_Element;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Set;
|
||||
(Container : in out Set;
|
||||
Position : Cursor;
|
||||
By : Element_Type)
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
Tree : Tree_Type renames Position.Container.Tree'Unrestricted_Access.all;
|
||||
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Tree, Position.Node, By);
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
Replace_Element (Container.Tree, Position.Node, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
---------------------
|
||||
|
|
@ -1563,6 +1755,19 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
return Set'(Controlled with Tree);
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
Tree : Tree_Type;
|
||||
Node : Node_Access;
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint (Tree, New_Item, Node);
|
||||
return Set'(Controlled with Tree);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1613,4 +1818,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Indefinite_Ordered_Multisets;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -47,6 +47,8 @@ generic
|
|||
package Ada.Containers.Indefinite_Ordered_Multisets is
|
||||
pragma Preelaborate;
|
||||
|
||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
|
||||
|
||||
type Set is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -59,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Length (Container : Set) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Set) return Boolean;
|
||||
|
|
@ -67,15 +71,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Set;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Set;
|
||||
Position : Cursor;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Move (Target : in out Set; Source : in out Set);
|
||||
|
||||
procedure Insert
|
||||
|
|
@ -85,6 +89,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
procedure Insert (Container : in out Set; New_Item : Element_Type);
|
||||
|
||||
-- TODO: include Replace too???
|
||||
--
|
||||
-- procedure Replace
|
||||
-- (Container : in out Set;
|
||||
-- New_Item : Element_Type);
|
||||
|
||||
procedure Exclude (Container : in out Set; Item : Element_Type);
|
||||
|
||||
procedure Delete (Container : in out Set; Item : Element_Type);
|
||||
|
||||
procedure Delete (Container : in out Set; Position : in out Cursor);
|
||||
|
|
@ -93,10 +105,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
procedure Delete_Last (Container : in out Set);
|
||||
|
||||
procedure Exclude (Container : in out Set; Item : Element_Type);
|
||||
|
||||
procedure Union (Target : in out Set;
|
||||
Source : Set);
|
||||
procedure Union (Target : in out Set; Source : Set);
|
||||
|
||||
function Union (Left, Right : Set) return Set;
|
||||
|
||||
|
|
@ -124,14 +133,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
|
||||
|
||||
function Contains (Container : Set; Item : Element_Type) return Boolean;
|
||||
|
||||
function Find (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Floor (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function First (Container : Set) return Cursor;
|
||||
|
||||
function First_Element (Container : Set) return Element_Type;
|
||||
|
|
@ -148,6 +149,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Floor (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Contains (Container : Set; Item : Element_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
function "<" (Left, Right : Cursor) return Boolean;
|
||||
|
|
@ -181,20 +190,23 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
|
||||
type Key_Type (<>) is limited private;
|
||||
type Key_Type (<>) is private;
|
||||
|
||||
with function Key (Element : Element_Type) return Key_Type;
|
||||
|
||||
with function "<" (Left : Key_Type; Right : Element_Type)
|
||||
return Boolean is <>;
|
||||
|
||||
with function ">" (Left : Key_Type; Right : Element_Type)
|
||||
return Boolean is <>;
|
||||
with function "<" (Left, Right : Key_Type) return Boolean is <>;
|
||||
|
||||
package Generic_Keys is
|
||||
|
||||
function Contains (Container : Set; Key : Key_Type) return Boolean;
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
|
||||
|
||||
function Key (Position : Cursor) return Key_Type;
|
||||
|
||||
function Element (Container : Set; Key : Key_Type) return Element_Type;
|
||||
|
||||
procedure Exclude (Container : in out Set; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Set; Key : Key_Type);
|
||||
|
||||
function Find (Container : Set; Key : Key_Type) return Cursor;
|
||||
|
||||
|
|
@ -202,21 +214,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
|
|||
|
||||
function Ceiling (Container : Set; Key : Key_Type) return Cursor;
|
||||
|
||||
function Key (Position : Cursor) return Key_Type;
|
||||
|
||||
function Element (Container : Set; Key : Key_Type) return Element_Type;
|
||||
|
||||
procedure Delete (Container : in out Set; Key : Key_Type);
|
||||
|
||||
procedure Exclude (Container : in out Set; Key : Key_Type);
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean;
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean;
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean;
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
|
||||
function Contains (Container : Set; Key : Key_Type) return Boolean;
|
||||
|
||||
procedure Update_Element_Preserving_Key
|
||||
(Container : in out Set;
|
||||
|
|
@ -266,6 +264,7 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -275,9 +274,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
|
||||
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -59,6 +59,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
procedure Free (X : in out Node_Access);
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean);
|
||||
|
||||
procedure Insert_With_Hint
|
||||
(Dst_Tree : in out Tree_Type;
|
||||
Dst_Hint : Node_Access;
|
||||
|
|
@ -144,16 +150,56 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null
|
||||
or else Right.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Element.all < Right.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Element.all < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Element.all;
|
||||
end "<";
|
||||
|
||||
|
|
@ -190,6 +236,24 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null
|
||||
or else Right.Node.Element = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
-- L > R same as R < L
|
||||
|
||||
return Right.Node.Element.all < Left.Node.Element.all;
|
||||
|
|
@ -197,11 +261,33 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function ">" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Element.all;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Right.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Element.all < Left;
|
||||
end ">";
|
||||
|
||||
|
|
@ -296,6 +382,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Delete");
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
Position.Container := null;
|
||||
|
|
@ -310,7 +399,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end Delete;
|
||||
|
||||
|
|
@ -366,6 +455,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element.all;
|
||||
end Element;
|
||||
|
||||
|
|
@ -467,6 +567,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function First_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.First.Element.all;
|
||||
end First_Element;
|
||||
|
||||
|
|
@ -491,7 +595,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
----------
|
||||
|
||||
procedure Free (X : in out Node_Access) is
|
||||
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
|
|
@ -500,6 +603,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
return;
|
||||
end if;
|
||||
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
begin
|
||||
Free_Element (X.Element);
|
||||
exception
|
||||
|
|
@ -593,6 +700,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
Key_Keys.Find (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Node.Element.all;
|
||||
end Element;
|
||||
|
||||
|
|
@ -685,6 +796,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Key (Position.Node.Element.all);
|
||||
end Key;
|
||||
|
||||
|
|
@ -724,10 +846,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element_Preserving_Key");
|
||||
|
||||
declare
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
K : constant Key_Type := Key (E);
|
||||
|
|
@ -811,35 +940,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
Position : out Cursor;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Insert_Post is
|
||||
new Element_Keys.Generic_Insert_Post (New_Node);
|
||||
|
||||
procedure Insert_Sans_Hint is
|
||||
new Element_Keys.Generic_Conditional_Insert (Insert_Post);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
Element : Element_Access := new Element_Type'(New_Item);
|
||||
begin
|
||||
return new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red,
|
||||
Element => Element);
|
||||
exception
|
||||
when others =>
|
||||
Free_Element (Element);
|
||||
raise;
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
|
|
@ -861,6 +961,54 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
end if;
|
||||
end Insert;
|
||||
|
||||
----------------------
|
||||
-- Insert_Sans_Hint --
|
||||
----------------------
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Insert_Post is
|
||||
new Element_Keys.Generic_Insert_Post (New_Node);
|
||||
|
||||
procedure Conditional_Insert_Sans_Hint is
|
||||
new Element_Keys.Generic_Conditional_Insert (Insert_Post);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
Element : Element_Access := new Element_Type'(New_Item);
|
||||
|
||||
begin
|
||||
return new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Element => Element);
|
||||
exception
|
||||
when others =>
|
||||
Free_Element (Element);
|
||||
raise;
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert_Sans_Hint
|
||||
|
||||
begin
|
||||
Conditional_Insert_Sans_Hint
|
||||
(Tree,
|
||||
New_Item,
|
||||
Node,
|
||||
Inserted);
|
||||
end Insert_Sans_Hint;
|
||||
|
||||
----------------------
|
||||
-- Insert_With_Hint --
|
||||
----------------------
|
||||
|
|
@ -1047,6 +1195,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function Last_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.Last.Element.all;
|
||||
end Last_Element;
|
||||
|
||||
|
|
@ -1095,6 +1247,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
|
@ -1141,6 +1296,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
|
@ -1162,29 +1320,40 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type))
|
||||
is
|
||||
E : Element_Type renames Position.Node.Element.all;
|
||||
|
||||
S : Set renames Position.Container.all;
|
||||
T : Tree_Type renames S.Tree'Unrestricted_Access.all;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
begin
|
||||
Process (Position.Node.Element.all);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -1227,6 +1396,14 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
-------------
|
||||
-- Replace --
|
||||
-------------
|
||||
|
|
@ -1242,6 +1419,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Container.Tree.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
X := Node.Element;
|
||||
Node.Element := new Element_Type'(New_Item);
|
||||
Free_Element (X);
|
||||
|
|
@ -1295,6 +1476,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Element := new Element_Type'(Item); -- OK if fails
|
||||
Node.Color := Red;
|
||||
Node.Parent := null;
|
||||
Node.Right := null;
|
||||
Node.Left := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1340,6 +1526,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Color := Red;
|
||||
Node.Parent := null;
|
||||
Node.Right := null;
|
||||
Node.Left := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1372,10 +1563,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Node.Element = null then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
Replace_Element (Container.Tree, Position.Node, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
|
|
@ -1482,6 +1680,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
return Set'(Controlled with Tree);
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
Tree : Tree_Type;
|
||||
Node : Node_Access;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
|
||||
return Set'(Controlled with Tree);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1532,4 +1744,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Indefinite_Ordered_Sets;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -61,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Sets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Length (Container : Set) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Set) return Boolean;
|
||||
|
|
@ -266,6 +268,7 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -275,9 +278,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -624,6 +624,7 @@ package body Ada.Containers.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;
|
||||
|
|
@ -695,6 +696,14 @@ package body Ada.Containers.Hashed_Maps is
|
|||
Read_Nodes (Stream, Container.HT);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------
|
||||
-- Read_Node --
|
||||
---------------
|
||||
|
|
@ -743,7 +752,11 @@ package body Ada.Containers.Hashed_Maps is
|
|||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
|
||||
|
||||
|
|
@ -751,11 +764,15 @@ package body Ada.Containers.Hashed_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container.HT.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Position.Node.Element := By;
|
||||
Position.Node.Element := New_Item;
|
||||
end Replace_Element;
|
||||
|
||||
----------------------
|
||||
|
|
@ -784,9 +801,10 @@ package body Ada.Containers.Hashed_Maps is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
pragma Assert (Vet (Position), "bad cursor in Update_Element");
|
||||
|
|
@ -795,12 +813,14 @@ package body Ada.Containers.Hashed_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
declare
|
||||
M : Map renames Position.Container.all;
|
||||
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
B : Natural renames HT.Busy;
|
||||
L : Natural renames HT.Lock;
|
||||
declare
|
||||
HT : Hash_Table_Type renames Container.HT;
|
||||
B : Natural renames HT.Busy;
|
||||
L : Natural renames HT.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
|
|
@ -809,7 +829,6 @@ package body Ada.Containers.Hashed_Maps is
|
|||
declare
|
||||
K : Key_Type renames Position.Node.Key;
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
|
|
@ -891,6 +910,14 @@ package body Ada.Containers.Hashed_Maps is
|
|||
Write_Nodes (Stream, Container.HT);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
----------------
|
||||
-- Write_Node --
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -39,13 +39,10 @@ with Ada.Finalization;
|
|||
|
||||
generic
|
||||
type Key_Type is private;
|
||||
|
||||
type Element_Type is private;
|
||||
|
||||
with function Hash (Key : Key_Type) return Hash_Type;
|
||||
|
||||
with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
|
||||
|
||||
with function "=" (Left, Right : Element_Type) return Boolean is <>;
|
||||
|
||||
package Ada.Containers.Hashed_Maps is
|
||||
|
|
@ -61,6 +58,11 @@ package Ada.Containers.Hashed_Maps is
|
|||
|
||||
function "=" (Left, Right : Map) return Boolean;
|
||||
|
||||
function Capacity (Container : Map) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity (Container : in out Map;
|
||||
Capacity : Count_Type);
|
||||
|
||||
function Length (Container : Map) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Map) return Boolean;
|
||||
|
|
@ -71,18 +73,22 @@ package Ada.Containers.Hashed_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access
|
||||
procedure (Key : Key_Type; Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access
|
||||
procedure (Key : Key_Type; Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type);
|
||||
|
||||
procedure Move (Target : in out Map; Source : in out Map);
|
||||
|
||||
procedure Insert
|
||||
|
|
@ -113,24 +119,24 @@ package Ada.Containers.Hashed_Maps is
|
|||
Key : Key_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Map; Position : in out Cursor);
|
||||
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type;
|
||||
|
||||
function First (Container : Map) return Cursor;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
function Equivalent_Keys (Left, Right : Cursor) return Boolean;
|
||||
|
|
@ -143,11 +149,6 @@ package Ada.Containers.Hashed_Maps is
|
|||
(Container : Map;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
function Capacity (Container : Map) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity (Container : in out Map;
|
||||
Capacity : Count_Type);
|
||||
|
||||
private
|
||||
pragma Inline ("=");
|
||||
pragma Inline (Length);
|
||||
|
|
@ -211,6 +212,18 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := (Container => null, Node => null);
|
||||
|
||||
end Ada.Containers.Hashed_Maps;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -72,6 +72,12 @@ package body Ada.Containers.Hashed_Sets is
|
|||
function Hash_Node (Node : Node_Access) return Hash_Type;
|
||||
pragma Inline (Hash_Node);
|
||||
|
||||
procedure Insert
|
||||
(HT : in out Hash_Table_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean);
|
||||
|
||||
function Is_In
|
||||
(HT : Hash_Table_Type;
|
||||
Key : Node_Access) return Boolean;
|
||||
|
|
@ -595,39 +601,8 @@ package body Ada.Containers.Hashed_Sets is
|
|||
Position : out Cursor;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node (Next : Node_Access) return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Local_Insert is
|
||||
new Element_Keys.Generic_Conditional_Insert (New_Node);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node (Next : Node_Access) return Node_Access is
|
||||
Node : constant Node_Access := new Node_Type'(New_Item, Next);
|
||||
begin
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
HT : Hash_Table_Type renames Container.HT;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
||||
begin
|
||||
if HT_Ops.Capacity (HT) = 0 then
|
||||
HT_Ops.Reserve_Capacity (HT, 1);
|
||||
end if;
|
||||
|
||||
Local_Insert (HT, New_Item, Position.Node, Inserted);
|
||||
|
||||
if Inserted
|
||||
and then HT.Length > HT_Ops.Capacity (HT)
|
||||
then
|
||||
HT_Ops.Reserve_Capacity (HT, HT.Length);
|
||||
end if;
|
||||
|
||||
Insert (Container.HT, New_Item, Position.Node, Inserted);
|
||||
Position.Container := Container'Unchecked_Access;
|
||||
end Insert;
|
||||
|
||||
|
|
@ -646,6 +621,43 @@ package body Ada.Containers.Hashed_Sets is
|
|||
end if;
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(HT : in out Hash_Table_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node (Next : Node_Access) return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Local_Insert is
|
||||
new Element_Keys.Generic_Conditional_Insert (New_Node);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node (Next : Node_Access) return Node_Access is
|
||||
begin
|
||||
return new Node_Type'(New_Item, Next);
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
||||
begin
|
||||
if HT_Ops.Capacity (HT) = 0 then
|
||||
HT_Ops.Reserve_Capacity (HT, 1);
|
||||
end if;
|
||||
|
||||
Local_Insert (HT, New_Item, Node, Inserted);
|
||||
|
||||
if Inserted
|
||||
and then HT.Length > HT_Ops.Capacity (HT)
|
||||
then
|
||||
HT_Ops.Reserve_Capacity (HT, HT.Length);
|
||||
end if;
|
||||
end Insert;
|
||||
|
||||
------------------
|
||||
-- Intersection --
|
||||
------------------
|
||||
|
|
@ -970,6 +982,14 @@ package body Ada.Containers.Hashed_Sets is
|
|||
Read_Nodes (Stream, Container.HT);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------
|
||||
-- Read_Node --
|
||||
---------------
|
||||
|
|
@ -1366,6 +1386,20 @@ package body Ada.Containers.Hashed_Sets is
|
|||
return (Controlled with HT => (Buckets, Length, 0, 0));
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
HT : Hash_Table_Type;
|
||||
Node : Node_Access;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert (HT, New_Item, Node, Inserted);
|
||||
return Set'(Controlled with HT);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1595,6 +1629,14 @@ package body Ada.Containers.Hashed_Sets is
|
|||
Write_Nodes (Stream, Container.HT);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
----------------
|
||||
-- Write_Node --
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -62,6 +62,8 @@ package Ada.Containers.Hashed_Sets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Capacity (Container : Set) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
|
|
@ -222,6 +224,7 @@ private
|
|||
|
||||
use HT_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -232,9 +235,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := (Container => null, Node => null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := (Container => null, Node => null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -475,44 +475,6 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
Count);
|
||||
end Append;
|
||||
|
||||
------------
|
||||
-- Assign --
|
||||
------------
|
||||
|
||||
procedure Assign
|
||||
(Target : in out Vector;
|
||||
Source : Vector)
|
||||
is
|
||||
N : constant Count_Type := Length (Source);
|
||||
|
||||
begin
|
||||
if Target'Address = Source'Address then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Clear (Target);
|
||||
|
||||
if N = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if N > Capacity (Target) then
|
||||
Reserve_Capacity (Target, Capacity => N);
|
||||
end if;
|
||||
|
||||
for J in Index_Type'First .. Source.Last loop
|
||||
declare
|
||||
EA : constant Element_Access := Source.Elements (J);
|
||||
begin
|
||||
if EA /= null then
|
||||
Target.Elements (J) := new Element_Type'(EA.all);
|
||||
end if;
|
||||
end;
|
||||
|
||||
Target.Last := J;
|
||||
end loop;
|
||||
end Assign;
|
||||
|
||||
--------------
|
||||
-- Capacity --
|
||||
--------------
|
||||
|
|
@ -553,7 +515,8 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
function Contains
|
||||
(Container : Vector;
|
||||
Item : Element_Type) return Boolean is
|
||||
Item : Element_Type) return Boolean
|
||||
is
|
||||
begin
|
||||
return Find_Index (Container, Item) /= No_Index;
|
||||
end Contains;
|
||||
|
|
@ -649,8 +612,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /=
|
||||
Vector_Access'(Container'Unchecked_Access)
|
||||
if Position.Container /= Container'Unchecked_Access
|
||||
or else Position.Index > Container.Last
|
||||
then
|
||||
raise Program_Error;
|
||||
|
|
@ -658,11 +620,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
Delete (Container, Position.Index, Count);
|
||||
|
||||
if Position.Index <= Container.Last then
|
||||
Position := (Container'Unchecked_Access, Position.Index);
|
||||
else
|
||||
Position := No_Element;
|
||||
end if;
|
||||
Position := No_Element; -- See comment in a-convec.adb
|
||||
end Delete;
|
||||
|
||||
------------------
|
||||
|
|
@ -738,7 +696,16 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Elements (Index).all;
|
||||
declare
|
||||
EA : constant Element_Access := Container.Elements (Index);
|
||||
|
||||
begin
|
||||
if EA = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return EA.all;
|
||||
end;
|
||||
end Element;
|
||||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
|
|
@ -773,13 +740,12 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
function Find
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor is
|
||||
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
begin
|
||||
if Position.Container /= null
|
||||
and then (Position.Container /=
|
||||
Vector_Access'(Container'Unchecked_Access)
|
||||
or else Position.Index > Container.Last)
|
||||
and then (Position.Container /= Container'Unchecked_Access
|
||||
or else Position.Index > Container.Last)
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
|
@ -802,7 +768,8 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
function Find_Index
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Index : Index_Type := Index_Type'First) return Extended_Index is
|
||||
Index : Index_Type := Index_Type'First) return Extended_Index
|
||||
is
|
||||
begin
|
||||
for Indx in Index .. Container.Last loop
|
||||
if Container.Elements (Indx) /= null
|
||||
|
|
@ -1287,7 +1254,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
begin
|
||||
if Before.Container /= null
|
||||
and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
|
||||
and then Before.Container /= Container'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
|
@ -1843,6 +1810,10 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if V.Elements (Index) = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
|
|
@ -1907,14 +1878,22 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
end loop;
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
By : Element_Type)
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Index > Container.Last then
|
||||
|
|
@ -1928,18 +1907,26 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
declare
|
||||
X : Element_Access := Container.Elements (Index);
|
||||
begin
|
||||
Container.Elements (Index) := new Element_Type'(By);
|
||||
Container.Elements (Index) := new Element_Type'(New_Item);
|
||||
Free (X);
|
||||
end;
|
||||
end Replace_Element;
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Position.Container.all, Position.Index, By);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Container, Position.Index, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
----------------------
|
||||
|
|
@ -2083,6 +2070,41 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
end;
|
||||
end Reserve_Capacity;
|
||||
|
||||
----------------------
|
||||
-- Reverse_Elements --
|
||||
----------------------
|
||||
|
||||
procedure Reverse_Elements (Container : in out Vector) is
|
||||
begin
|
||||
if Container.Length <= 1 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
declare
|
||||
I : Index_Type := Index_Type'First;
|
||||
J : Index_Type := Container.Last;
|
||||
E : Elements_Type renames Container.Elements.all;
|
||||
|
||||
begin
|
||||
while I < J loop
|
||||
declare
|
||||
EI : constant Element_Access := E (I);
|
||||
|
||||
begin
|
||||
E (I) := E (J);
|
||||
E (J) := EI;
|
||||
end;
|
||||
|
||||
I := I + 1;
|
||||
J := J - 1;
|
||||
end loop;
|
||||
end;
|
||||
end Reverse_Elements;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
|
|
@ -2096,8 +2118,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
begin
|
||||
if Position.Container /= null
|
||||
and then Position.Container /=
|
||||
Vector_Access'(Container'Unchecked_Access)
|
||||
and then Position.Container /= Container'Unchecked_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
|
@ -2230,7 +2251,7 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
----------
|
||||
|
||||
procedure Swap
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
I, J : Index_Type)
|
||||
is
|
||||
begin
|
||||
|
|
@ -2260,7 +2281,9 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
end;
|
||||
end Swap;
|
||||
|
||||
procedure Swap (I, J : Cursor)
|
||||
procedure Swap
|
||||
(Container : in out Vector;
|
||||
I, J : Cursor)
|
||||
is
|
||||
begin
|
||||
if I.Container = null
|
||||
|
|
@ -2269,11 +2292,13 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if I.Container /= J.Container then
|
||||
if I.Container /= Container'Unrestricted_Access
|
||||
or else J.Container /= Container'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Swap (I.Container.all, I.Index, J.Index);
|
||||
Swap (Container, I.Index, J.Index);
|
||||
end Swap;
|
||||
|
||||
---------------
|
||||
|
|
@ -2387,24 +2412,27 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
V : Vector renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames V.Busy;
|
||||
L : Natural renames V.Lock;
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
if Index > Container.Last then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Container.Elements (Index) = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
begin
|
||||
Process (V.Elements (Index).all);
|
||||
Process (Container.Elements (Index).all);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
|
|
@ -2417,15 +2445,20 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
end Update_Element;
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Update_Element (Position.Container.all, Position.Index, Process);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Update_Element (Container, Position.Index, Process);
|
||||
end Update_Element;
|
||||
|
||||
-----------
|
||||
|
|
@ -2466,4 +2499,12 @@ package body Ada.Containers.Indefinite_Vectors is
|
|||
end;
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Indefinite_Vectors;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -38,7 +38,6 @@ with Ada.Streams;
|
|||
|
||||
generic
|
||||
type Index_Type is range <>;
|
||||
|
||||
type Element_Type (<>) is private;
|
||||
|
||||
with function "=" (Left, Right : Element_Type) return Boolean is <>;
|
||||
|
|
@ -52,8 +51,6 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
No_Index : constant Extended_Index := Extended_Index'First;
|
||||
|
||||
subtype Index_Subtype is Index_Type;
|
||||
|
||||
type Vector is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -62,6 +59,8 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
No_Element : constant Cursor;
|
||||
|
||||
function "=" (Left, Right : Vector) return Boolean;
|
||||
|
||||
function To_Vector (Length : Count_Type) return Vector;
|
||||
|
||||
function To_Vector
|
||||
|
|
@ -76,8 +75,6 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
function "&" (Left, Right : Element_Type) return Vector;
|
||||
|
||||
function "=" (Left, Right : Vector) return Boolean;
|
||||
|
||||
function Capacity (Container : Vector) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
|
|
@ -86,6 +83,10 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
function Length (Container : Vector) return Count_Type;
|
||||
|
||||
procedure Set_Length
|
||||
(Container : in out Vector;
|
||||
Length : Count_Type);
|
||||
|
||||
function Is_Empty (Container : Vector) return Boolean;
|
||||
|
||||
procedure Clear (Container : in out Vector);
|
||||
|
|
@ -102,6 +103,16 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Container : Vector;
|
||||
Index : Index_Type;
|
||||
|
|
@ -112,24 +123,14 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Vector;
|
||||
Index : Index_Type;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Replace_Element
|
||||
(Position : Cursor;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Assign (Target : in out Vector; Source : Vector);
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Move (Target : in out Vector; Source : in out Vector);
|
||||
|
||||
|
|
@ -197,10 +198,6 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Set_Length
|
||||
(Container : in out Vector;
|
||||
Length : Count_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Vector;
|
||||
Index : Extended_Index;
|
||||
|
|
@ -219,6 +216,12 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
(Container : in out Vector;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Reverse_Elements (Container : in out Vector);
|
||||
|
||||
procedure Swap (Container : in out Vector; I, J : Index_Type);
|
||||
|
||||
procedure Swap (Container : in out Vector; I, J : Cursor);
|
||||
|
||||
function First_Index (Container : Vector) return Index_Type;
|
||||
|
||||
function First (Container : Vector) return Cursor;
|
||||
|
|
@ -231,21 +234,13 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
|
||||
function Last_Element (Container : Vector) return Element_Type;
|
||||
|
||||
procedure Swap (Container : Vector; I, J : Index_Type);
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Swap (I, J : Cursor);
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
function Is_Sorted (Container : Vector) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out Vector);
|
||||
|
||||
procedure Merge (Target, Source : in out Vector);
|
||||
|
||||
end Generic_Sorting;
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find_Index
|
||||
(Container : Vector;
|
||||
|
|
@ -255,30 +250,22 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
function Find
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor;
|
||||
Position : Cursor := No_Element) return Cursor;
|
||||
|
||||
function Reverse_Find_Index
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Index : Index_Type := Index_Type'Last) return Extended_Index;
|
||||
|
||||
function Reverse_Find (Container : Vector;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element)
|
||||
return Cursor;
|
||||
function Reverse_Find
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor;
|
||||
|
||||
function Contains
|
||||
(Container : Vector;
|
||||
Item : Element_Type) return Boolean;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
procedure Iterate
|
||||
|
|
@ -289,6 +276,18 @@ package Ada.Containers.Indefinite_Vectors is
|
|||
(Container : Vector;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
|
||||
function Is_Sorted (Container : Vector) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out Vector);
|
||||
|
||||
procedure Merge (Target : in out Vector; Source : in out Vector);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
private
|
||||
|
||||
pragma Inline (First_Index);
|
||||
|
|
@ -346,6 +345,18 @@ private
|
|||
Index : Index_Type := Index_Type'First;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
|
||||
|
||||
end Ada.Containers.Indefinite_Vectors;
|
||||
|
|
|
|||
|
|
@ -303,37 +303,6 @@ package body Ada.Containers.Vectors is
|
|||
Count);
|
||||
end Append;
|
||||
|
||||
------------
|
||||
-- Assign --
|
||||
------------
|
||||
|
||||
procedure Assign
|
||||
(Target : in out Vector;
|
||||
Source : Vector)
|
||||
is
|
||||
N : constant Count_Type := Length (Source);
|
||||
|
||||
begin
|
||||
if Target'Address = Source'Address then
|
||||
return;
|
||||
end if;
|
||||
|
||||
Clear (Target);
|
||||
|
||||
if N = 0 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if N > Capacity (Target) then
|
||||
Reserve_Capacity (Target, Capacity => N);
|
||||
end if;
|
||||
|
||||
Target.Elements (Index_Type'First .. Source.Last) :=
|
||||
Source.Elements (Index_Type'First .. Source.Last);
|
||||
|
||||
Target.Last := Source.Last;
|
||||
end Assign;
|
||||
|
||||
--------------
|
||||
-- Capacity --
|
||||
--------------
|
||||
|
|
@ -443,8 +412,7 @@ package body Ada.Containers.Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /=
|
||||
Vector_Access'(Container'Unchecked_Access)
|
||||
if Position.Container /= Container'Unrestricted_Access
|
||||
or else Position.Index > Container.Last
|
||||
then
|
||||
raise Program_Error;
|
||||
|
|
@ -452,11 +420,17 @@ package body Ada.Containers.Vectors is
|
|||
|
||||
Delete (Container, Position.Index, Count);
|
||||
|
||||
if Position.Index <= Container.Last then
|
||||
Position := (Container'Unchecked_Access, Position.Index);
|
||||
else
|
||||
Position := No_Element;
|
||||
end if;
|
||||
-- This is the old behavior, prior to the York API (2005/06):
|
||||
|
||||
-- if Position.Index <= Container.Last then
|
||||
-- Position := (Container'Unchecked_Access, Position.Index);
|
||||
-- else
|
||||
-- Position := No_Element;
|
||||
-- end if;
|
||||
|
||||
-- This is the behavior specified by the York API:
|
||||
|
||||
Position := No_Element;
|
||||
end Delete;
|
||||
|
||||
------------------
|
||||
|
|
@ -539,6 +513,7 @@ package body Ada.Containers.Vectors is
|
|||
|
||||
procedure Finalize (Container : in out Vector) is
|
||||
X : Elements_Access := Container.Elements;
|
||||
|
||||
begin
|
||||
if Container.Busy > 0 then
|
||||
raise Program_Error;
|
||||
|
|
@ -556,13 +531,12 @@ package body Ada.Containers.Vectors is
|
|||
function Find
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Position : Cursor := No_Element) return Cursor is
|
||||
|
||||
Position : Cursor := No_Element) return Cursor
|
||||
is
|
||||
begin
|
||||
if Position.Container /= null
|
||||
and then (Position.Container /=
|
||||
Vector_Access'(Container'Unchecked_Access)
|
||||
or else Position.Index > Container.Last)
|
||||
and then (Position.Container /= Container'Unrestricted_Access
|
||||
or else Position.Index > Container.Last)
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
|
@ -583,7 +557,8 @@ package body Ada.Containers.Vectors is
|
|||
function Find_Index
|
||||
(Container : Vector;
|
||||
Item : Element_Type;
|
||||
Index : Index_Type := Index_Type'First) return Extended_Index is
|
||||
Index : Index_Type := Index_Type'First) return Extended_Index
|
||||
is
|
||||
begin
|
||||
for Indx in Index .. Container.Last loop
|
||||
if Container.Elements (Indx) = Item then
|
||||
|
|
@ -1152,6 +1127,31 @@ package body Ada.Containers.Vectors is
|
|||
Position := Cursor'(Container'Unchecked_Access, Index);
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Vector;
|
||||
Before : Extended_Index;
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
New_Item : Element_Type; -- Default-initialized value
|
||||
pragma Warnings (Off, New_Item);
|
||||
|
||||
begin
|
||||
Insert (Container, Before, New_Item, Count);
|
||||
end Insert;
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Vector;
|
||||
Before : Cursor;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
New_Item : Element_Type; -- Default-initialized value
|
||||
pragma Warnings (Off, New_Item);
|
||||
|
||||
begin
|
||||
Insert (Container, Before, New_Item, Position, Count);
|
||||
end Insert;
|
||||
|
||||
------------------
|
||||
-- Insert_Space --
|
||||
------------------
|
||||
|
|
@ -1339,7 +1339,7 @@ package body Ada.Containers.Vectors is
|
|||
Index := Before.Index;
|
||||
end if;
|
||||
|
||||
Insert_Space (Container, Index, Count);
|
||||
Insert_Space (Container, Index, Count => Count);
|
||||
|
||||
Position := Cursor'(Container'Unchecked_Access, Index);
|
||||
end Insert_Space;
|
||||
|
|
@ -1365,7 +1365,6 @@ package body Ada.Containers.Vectors is
|
|||
B : Natural renames V.Busy;
|
||||
|
||||
begin
|
||||
|
||||
B := B + 1;
|
||||
|
||||
begin
|
||||
|
|
@ -1379,7 +1378,6 @@ package body Ada.Containers.Vectors is
|
|||
end;
|
||||
|
||||
B := B - 1;
|
||||
|
||||
end Iterate;
|
||||
|
||||
----------
|
||||
|
|
@ -1620,14 +1618,22 @@ package body Ada.Containers.Vectors is
|
|||
end loop;
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
By : Element_Type)
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Index > Container.Last then
|
||||
|
|
@ -1638,16 +1644,24 @@ package body Ada.Containers.Vectors is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Container.Elements (Index) := By;
|
||||
Container.Elements (Index) := New_Item;
|
||||
end Replace_Element;
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Position.Container.all, Position.Index, By);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Container, Position.Index, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
----------------------
|
||||
|
|
@ -1799,6 +1813,41 @@ package body Ada.Containers.Vectors is
|
|||
end;
|
||||
end Reserve_Capacity;
|
||||
|
||||
----------------------
|
||||
-- Reverse_Elements --
|
||||
----------------------
|
||||
|
||||
procedure Reverse_Elements (Container : in out Vector) is
|
||||
begin
|
||||
if Container.Length <= 1 then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Container.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
declare
|
||||
I : Index_Type := Index_Type'First;
|
||||
J : Index_Type := Container.Last;
|
||||
E : Elements_Type renames Container.Elements.all;
|
||||
|
||||
begin
|
||||
while I < J loop
|
||||
declare
|
||||
EI : constant Element_Type := E (I);
|
||||
|
||||
begin
|
||||
E (I) := E (J);
|
||||
E (J) := EI;
|
||||
end;
|
||||
|
||||
I := I + 1;
|
||||
J := J - 1;
|
||||
end loop;
|
||||
end;
|
||||
end Reverse_Elements;
|
||||
|
||||
------------------
|
||||
-- Reverse_Find --
|
||||
------------------
|
||||
|
|
@ -1921,7 +1970,7 @@ package body Ada.Containers.Vectors is
|
|||
-- Swap --
|
||||
----------
|
||||
|
||||
procedure Swap (Container : Vector; I, J : Index_Type) is
|
||||
procedure Swap (Container : in out Vector; I, J : Index_Type) is
|
||||
begin
|
||||
if I > Container.Last
|
||||
or else J > Container.Last
|
||||
|
|
@ -1949,7 +1998,7 @@ package body Ada.Containers.Vectors is
|
|||
end;
|
||||
end Swap;
|
||||
|
||||
procedure Swap (I, J : Cursor) is
|
||||
procedure Swap (Container : in out Vector; I, J : Cursor) is
|
||||
begin
|
||||
if I.Container = null
|
||||
or else J.Container = null
|
||||
|
|
@ -1957,11 +2006,13 @@ package body Ada.Containers.Vectors is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if I.Container /= J.Container then
|
||||
if I.Container /= Container'Unrestricted_Access
|
||||
or else J.Container /= Container'Unrestricted_Access
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Swap (I.Container.all, I.Index, J.Index);
|
||||
Swap (Container, I.Index, J.Index);
|
||||
end Swap;
|
||||
|
||||
---------------
|
||||
|
|
@ -2057,13 +2108,12 @@ package body Ada.Containers.Vectors is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
V : Vector renames Container'Unrestricted_Access.all;
|
||||
B : Natural renames V.Busy;
|
||||
L : Natural renames V.Lock;
|
||||
B : Natural renames Container.Busy;
|
||||
L : Natural renames Container.Lock;
|
||||
|
||||
begin
|
||||
if Index > Container.Last then
|
||||
|
|
@ -2074,7 +2124,7 @@ package body Ada.Containers.Vectors is
|
|||
L := L + 1;
|
||||
|
||||
begin
|
||||
Process (V.Elements (Index));
|
||||
Process (Container.Elements (Index));
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
|
|
@ -2087,15 +2137,20 @@ package body Ada.Containers.Vectors is
|
|||
end Update_Element;
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type))
|
||||
is
|
||||
begin
|
||||
if Position.Container = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Update_Element (Position.Container.all, Position.Index, Process);
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Update_Element (Container, Position.Index, Process);
|
||||
end Update_Element;
|
||||
|
||||
-----------
|
||||
|
|
@ -2114,4 +2169,12 @@ package body Ada.Containers.Vectors is
|
|||
end loop;
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Vectors;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -50,8 +50,6 @@ package Ada.Containers.Vectors is
|
|||
|
||||
No_Index : constant Extended_Index := Extended_Index'First;
|
||||
|
||||
subtype Index_Subtype is Index_Type;
|
||||
|
||||
type Vector is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -60,6 +58,8 @@ package Ada.Containers.Vectors is
|
|||
|
||||
No_Element : constant Cursor;
|
||||
|
||||
function "=" (Left, Right : Vector) return Boolean;
|
||||
|
||||
function To_Vector (Length : Count_Type) return Vector;
|
||||
|
||||
function To_Vector
|
||||
|
|
@ -74,8 +74,6 @@ package Ada.Containers.Vectors is
|
|||
|
||||
function "&" (Left, Right : Element_Type) return Vector;
|
||||
|
||||
function "=" (Left, Right : Vector) return Boolean;
|
||||
|
||||
function Capacity (Container : Vector) return Count_Type;
|
||||
|
||||
procedure Reserve_Capacity
|
||||
|
|
@ -84,6 +82,10 @@ package Ada.Containers.Vectors is
|
|||
|
||||
function Length (Container : Vector) return Count_Type;
|
||||
|
||||
procedure Set_Length
|
||||
(Container : in out Vector;
|
||||
Length : Count_Type);
|
||||
|
||||
function Is_Empty (Container : Vector) return Boolean;
|
||||
|
||||
procedure Clear (Container : in out Vector);
|
||||
|
|
@ -100,6 +102,16 @@ package Ada.Containers.Vectors is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Container : Vector;
|
||||
Index : Index_Type;
|
||||
|
|
@ -110,22 +122,14 @@ package Ada.Containers.Vectors is
|
|||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Container : Vector;
|
||||
(Container : in out Vector;
|
||||
Index : Index_Type;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Vector;
|
||||
Index : Index_Type;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type);
|
||||
|
||||
procedure Assign (Target : in out Vector; Source : Vector);
|
||||
(Container : in out Vector;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Move (Target : in out Vector; Source : in out Vector);
|
||||
|
||||
|
|
@ -164,6 +168,17 @@ package Ada.Containers.Vectors is
|
|||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Vector;
|
||||
Before : Extended_Index;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Vector;
|
||||
Before : Cursor;
|
||||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Prepend
|
||||
(Container : in out Vector;
|
||||
New_Item : Vector);
|
||||
|
|
@ -193,10 +208,6 @@ package Ada.Containers.Vectors is
|
|||
Position : out Cursor;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Set_Length
|
||||
(Container : in out Vector;
|
||||
Length : Count_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Vector;
|
||||
Index : Extended_Index;
|
||||
|
|
@ -215,6 +226,12 @@ package Ada.Containers.Vectors is
|
|||
(Container : in out Vector;
|
||||
Count : Count_Type := 1);
|
||||
|
||||
procedure Reverse_Elements (Container : in out Vector);
|
||||
|
||||
procedure Swap (Container : in out Vector; I, J : Index_Type);
|
||||
|
||||
procedure Swap (Container : in out Vector; I, J : Cursor);
|
||||
|
||||
function First_Index (Container : Vector) return Index_Type;
|
||||
|
||||
function First (Container : Vector) return Cursor;
|
||||
|
|
@ -227,21 +244,13 @@ package Ada.Containers.Vectors is
|
|||
|
||||
function Last_Element (Container : Vector) return Element_Type;
|
||||
|
||||
procedure Swap (Container : Vector; I, J : Index_Type);
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Swap (I, J : Cursor);
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
function Is_Sorted (Container : Vector) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out Vector);
|
||||
|
||||
procedure Merge (Target, Source : in out Vector);
|
||||
|
||||
end Generic_Sorting;
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find_Index
|
||||
(Container : Vector;
|
||||
|
|
@ -267,14 +276,6 @@ package Ada.Containers.Vectors is
|
|||
(Container : Vector;
|
||||
Item : Element_Type) return Boolean;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
procedure Iterate
|
||||
|
|
@ -285,6 +286,18 @@ package Ada.Containers.Vectors is
|
|||
(Container : Vector;
|
||||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
with function "<" (Left, Right : Element_Type) return Boolean is <>;
|
||||
package Generic_Sorting is
|
||||
|
||||
function Is_Sorted (Container : Vector) return Boolean;
|
||||
|
||||
procedure Sort (Container : in out Vector);
|
||||
|
||||
procedure Merge (Target : in out Vector; Source : in out Vector);
|
||||
|
||||
end Generic_Sorting;
|
||||
|
||||
private
|
||||
|
||||
pragma Inline (First_Index);
|
||||
|
|
@ -340,6 +353,18 @@ private
|
|||
Index : Index_Type := Index_Type'First;
|
||||
end record;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : Cursor);
|
||||
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Position : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
|
||||
|
||||
end Ada.Containers.Vectors;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -81,6 +81,8 @@ package body Ada.Containers.Ordered_Maps is
|
|||
function Copy_Node (Source : Node_Access) return Node_Access;
|
||||
pragma Inline (Copy_Node);
|
||||
|
||||
procedure Free (X : in out Node_Access);
|
||||
|
||||
function Is_Equal_Node_Node (L, R : Node_Access) return Boolean;
|
||||
pragma Inline (Is_Equal_Node_Node);
|
||||
|
||||
|
|
@ -98,8 +100,6 @@ package body Ada.Containers.Ordered_Maps is
|
|||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
package Tree_Operations is
|
||||
new Red_Black_Trees.Generic_Operations (Tree_Types);
|
||||
|
||||
|
|
@ -127,16 +127,42 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Key < Right.Node.Key;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Key < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Key;
|
||||
end "<";
|
||||
|
||||
|
|
@ -155,16 +181,42 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Key < Left.Node.Key;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Key;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Key < Left;
|
||||
end ">";
|
||||
|
||||
|
|
@ -231,12 +283,12 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
function Copy_Node (Source : Node_Access) return Node_Access is
|
||||
Target : constant Node_Access :=
|
||||
new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Source.Color,
|
||||
new Node_Type'(Color => Source.Color,
|
||||
Key => Source.Key,
|
||||
Element => Source.Element);
|
||||
Element => Source.Element,
|
||||
Parent => null,
|
||||
Left => null,
|
||||
Right => null);
|
||||
begin
|
||||
return Target;
|
||||
end Copy_Node;
|
||||
|
|
@ -246,16 +298,20 @@ package body Ada.Containers.Ordered_Maps is
|
|||
------------
|
||||
|
||||
procedure Delete (Container : in out Map; Position : in out Cursor) is
|
||||
Tree : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Map_Access'(Container'Unrestricted_Access) then
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
pragma Assert (Vet (Tree, Position.Node), "bad cursor in Delete");
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
|
||||
Position.Container := null;
|
||||
|
|
@ -269,7 +325,7 @@ package body Ada.Containers.Ordered_Maps is
|
|||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end Delete;
|
||||
|
||||
|
|
@ -279,6 +335,7 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
procedure Delete_First (Container : in out Map) is
|
||||
X : Node_Access := Container.Tree.First;
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
|
|
@ -292,6 +349,7 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
procedure Delete_Last (Container : in out Map) is
|
||||
X : Node_Access := Container.Tree.Last;
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
|
|
@ -305,15 +363,42 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element;
|
||||
end Element;
|
||||
|
||||
function Element (Container : Map; Key : Key_Type) return Element_Type is
|
||||
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||
|
||||
begin
|
||||
if Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Node.Element;
|
||||
end Element;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Keys --
|
||||
---------------------
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Keys;
|
||||
|
||||
-------------
|
||||
-- Exclude --
|
||||
-------------
|
||||
|
|
@ -323,7 +408,7 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
begin
|
||||
if X /= null then
|
||||
Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||
Free (X);
|
||||
end if;
|
||||
end Exclude;
|
||||
|
|
@ -348,12 +433,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
-----------
|
||||
|
||||
function First (Container : Map) return Cursor is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
if T.First = null then
|
||||
return No_Element;
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
|
||||
return Cursor'(Container'Unrestricted_Access, T.First);
|
||||
end First;
|
||||
|
||||
-------------------
|
||||
|
|
@ -361,8 +448,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
-------------------
|
||||
|
||||
function First_Element (Container : Map) return Element_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.First.Element;
|
||||
if T.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.First.Element;
|
||||
end First_Element;
|
||||
|
||||
---------------
|
||||
|
|
@ -370,8 +463,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
---------------
|
||||
|
||||
function First_Key (Container : Map) return Key_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.First.Key;
|
||||
if T.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.First.Key;
|
||||
end First_Key;
|
||||
|
||||
-----------
|
||||
|
|
@ -389,6 +488,26 @@ package body Ada.Containers.Ordered_Maps is
|
|||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end Floor;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
||||
procedure Free (X : in out Node_Access) is
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
begin
|
||||
if X = null then
|
||||
return;
|
||||
end if;
|
||||
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
Deallocate (X);
|
||||
end Free;
|
||||
|
||||
-----------------
|
||||
-- Has_Element --
|
||||
-----------------
|
||||
|
|
@ -444,15 +563,13 @@ package body Ada.Containers.Ordered_Maps is
|
|||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
Node : constant Node_Access :=
|
||||
new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red,
|
||||
Key => Key,
|
||||
Element => New_Item);
|
||||
begin
|
||||
return Node;
|
||||
return new Node_Type'(Key => Key,
|
||||
Element => New_Item,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Parent => null,
|
||||
Left => null,
|
||||
Right => null);
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
|
@ -507,18 +624,13 @@ package body Ada.Containers.Ordered_Maps is
|
|||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
Node : Node_Access := new Node_Type;
|
||||
|
||||
begin
|
||||
begin
|
||||
Node.Key := Key;
|
||||
exception
|
||||
when others =>
|
||||
Free (Node);
|
||||
raise;
|
||||
end;
|
||||
|
||||
return Node;
|
||||
return new Node_Type'(Key => Key,
|
||||
Element => <>,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Parent => null,
|
||||
Left => null,
|
||||
Right => null);
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
|
@ -633,6 +745,13 @@ package body Ada.Containers.Ordered_Maps is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Position.Node.Key;
|
||||
end Key;
|
||||
|
||||
|
|
@ -641,12 +760,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
----------
|
||||
|
||||
function Last (Container : Map) return Cursor is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
if T.Last = null then
|
||||
return No_Element;
|
||||
end if;
|
||||
|
||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
|
||||
return Cursor'(Container'Unrestricted_Access, T.Last);
|
||||
end Last;
|
||||
|
||||
------------------
|
||||
|
|
@ -654,8 +775,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
------------------
|
||||
|
||||
function Last_Element (Container : Map) return Element_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.Last.Element;
|
||||
if T.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.Last.Element;
|
||||
end Last_Element;
|
||||
|
||||
--------------
|
||||
|
|
@ -663,8 +790,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
--------------
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type is
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
begin
|
||||
return Container.Tree.Last.Key;
|
||||
if T.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return T.Last.Key;
|
||||
end Last_Key;
|
||||
|
||||
----------
|
||||
|
|
@ -712,6 +845,9 @@ package body Ada.Containers.Ordered_Maps is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
|
@ -749,6 +885,9 @@ package body Ada.Containers.Ordered_Maps is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
|
@ -771,29 +910,40 @@ package body Ada.Containers.Ordered_Maps is
|
|||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : Element_Type))
|
||||
is
|
||||
K : Key_Type renames Position.Node.Key;
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
declare
|
||||
K : Key_Type renames Position.Node.Key;
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -835,6 +985,14 @@ package body Ada.Containers.Ordered_Maps is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
-------------
|
||||
-- Replace --
|
||||
-------------
|
||||
|
|
@ -863,15 +1021,28 @@ package body Ada.Containers.Ordered_Maps is
|
|||
-- Replace_Element --
|
||||
---------------------
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : Element_Type) is
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
begin
|
||||
if Position.Container.Tree.Lock > 0 then
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
E := By;
|
||||
if Container.Tree.Lock > 0 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
Position.Node.Element := New_Item;
|
||||
end Replace_Element;
|
||||
|
||||
---------------------
|
||||
|
|
@ -968,33 +1139,49 @@ package body Ada.Containers.Ordered_Maps is
|
|||
--------------------
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access procedure (Key : Key_Type;
|
||||
Element : in out Element_Type))
|
||||
is
|
||||
K : Key_Type renames Position.Node.Key;
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Position.Container /= Container'Unrestricted_Access then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
declare
|
||||
K : Key_Type renames Position.Node.Key;
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
begin
|
||||
Process (K, E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Update_Element;
|
||||
|
||||
-----------
|
||||
|
|
@ -1032,4 +1219,12 @@ package body Ada.Containers.Ordered_Maps is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Ordered_Maps;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -38,9 +38,7 @@ with Ada.Finalization;
|
|||
with Ada.Streams;
|
||||
|
||||
generic
|
||||
|
||||
type Key_Type is private;
|
||||
|
||||
type Element_Type is private;
|
||||
|
||||
with function "<" (Left, Right : Key_Type) return Boolean is <>;
|
||||
|
|
@ -49,6 +47,8 @@ generic
|
|||
package Ada.Containers.Ordered_Maps is
|
||||
pragma Preelaborate;
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
|
||||
|
||||
type Map is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -69,18 +69,22 @@ package Ada.Containers.Ordered_Maps is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access
|
||||
procedure (Key : Key_Type; Element : Element_Type));
|
||||
|
||||
procedure Update_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access
|
||||
(Container : in out Map;
|
||||
Position : Cursor;
|
||||
Process : not null access
|
||||
procedure (Key : Key_Type; Element : in out Element_Type));
|
||||
|
||||
procedure Replace_Element (Position : Cursor; By : in Element_Type);
|
||||
|
||||
procedure Move (Target : in out Map; Source : in out Map);
|
||||
|
||||
procedure Insert
|
||||
|
|
@ -111,6 +115,8 @@ package Ada.Containers.Ordered_Maps is
|
|||
Key : Key_Type;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Map; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Map; Position : in out Cursor);
|
||||
|
|
@ -119,9 +125,25 @@ package Ada.Containers.Ordered_Maps is
|
|||
|
||||
procedure Delete_Last (Container : in out Map);
|
||||
|
||||
procedure Exclude (Container : in out Map; Key : Key_Type);
|
||||
function First (Container : Map) return Cursor;
|
||||
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
function First_Element (Container : Map) return Element_Type;
|
||||
|
||||
function First_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Last (Container : Map) return Cursor;
|
||||
|
||||
function Last_Element (Container : Map) return Element_Type;
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
|
|
@ -131,25 +153,7 @@ package Ada.Containers.Ordered_Maps is
|
|||
|
||||
function Ceiling (Container : Map; Key : Key_Type) return Cursor;
|
||||
|
||||
function First (Container : Map) return Cursor;
|
||||
|
||||
function First_Key (Container : Map) return Key_Type;
|
||||
|
||||
function First_Element (Container : Map) return Element_Type;
|
||||
|
||||
function Last (Container : Map) return Cursor;
|
||||
|
||||
function Last_Key (Container : Map) return Key_Type;
|
||||
|
||||
function Last_Element (Container : Map) return Element_Type;
|
||||
|
||||
function Next (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Next (Position : in out Cursor);
|
||||
|
||||
function Previous (Position : Cursor) return Cursor;
|
||||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
function Contains (Container : Map; Key : Key_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
|
|
@ -202,8 +206,9 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Map_Access is access Map;
|
||||
type Map_Access is access all Map;
|
||||
for Map_Access'Storage_Size use 0;
|
||||
|
||||
type Cursor is record
|
||||
|
|
@ -211,9 +216,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -84,6 +84,13 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
function Copy_Node (Source : Node_Access) return Node_Access;
|
||||
pragma Inline (Copy_Node);
|
||||
|
||||
procedure Free (X : in out Node_Access);
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access);
|
||||
|
||||
procedure Insert_With_Hint
|
||||
(Dst_Tree : in out Tree_Type;
|
||||
Dst_Hint : Node_Access;
|
||||
|
|
@ -115,9 +122,6 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
package Tree_Operations is
|
||||
new Red_Black_Trees.Generic_Operations (Tree_Types);
|
||||
|
||||
|
|
@ -154,18 +158,44 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Element < Right.Node.Element;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Element_Type)
|
||||
return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Element < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Element_Type; Right : Cursor)
|
||||
return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Element;
|
||||
end "<";
|
||||
|
||||
|
|
@ -184,6 +214,18 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
-- L > R same as R < L
|
||||
|
||||
return Right.Node.Element < Left.Node.Element;
|
||||
|
|
@ -192,12 +234,26 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
function ">" (Left : Cursor; Right : Element_Type)
|
||||
return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Element;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Element_Type; Right : Cursor)
|
||||
return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Element < Left;
|
||||
end ">";
|
||||
|
||||
|
|
@ -299,7 +355,7 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
end loop;
|
||||
end Delete;
|
||||
|
||||
procedure Delete (Container : in out Set; Position : in out Cursor) is
|
||||
procedure Delete (Container : in out Set; Position : in out Cursor) is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
|
|
@ -309,6 +365,9 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Delete");
|
||||
|
||||
Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
|
||||
|
|
@ -371,9 +430,31 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element;
|
||||
end Element;
|
||||
|
||||
-------------------------
|
||||
-- Equivalent_Elements --
|
||||
-------------------------
|
||||
|
||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Elements;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Sets --
|
||||
---------------------
|
||||
|
|
@ -460,6 +541,10 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function First_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.First.Element;
|
||||
end First_Element;
|
||||
|
||||
|
|
@ -479,6 +564,24 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end Floor;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
||||
procedure Free (X : in out Node_Access) is
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
Deallocate (X);
|
||||
end if;
|
||||
end Free;
|
||||
|
||||
------------------
|
||||
-- Generic_Keys --
|
||||
------------------
|
||||
|
|
@ -510,34 +613,6 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
Is_Less_Key_Node => Is_Less_Key_Node,
|
||||
Is_Greater_Key_Node => Is_Greater_Key_Node);
|
||||
|
||||
---------
|
||||
-- "<" --
|
||||
---------
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
return Left < Right.Node.Element;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
return Right > Left.Node.Element;
|
||||
end "<";
|
||||
|
||||
---------
|
||||
-- ">" --
|
||||
---------
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
|
||||
begin
|
||||
return Right < Left.Node.Element;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
return Left > Right.Node.Element;
|
||||
end ">";
|
||||
|
||||
-------------
|
||||
-- Ceiling --
|
||||
-------------
|
||||
|
|
@ -596,9 +671,28 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
Node : constant Node_Access :=
|
||||
Key_Keys.Find (Container.Tree, Key);
|
||||
begin
|
||||
if Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Node.Element;
|
||||
end Element;
|
||||
|
||||
---------------------
|
||||
-- Equivalent_Keys --
|
||||
---------------------
|
||||
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||
begin
|
||||
if Left < Right
|
||||
or else Right < Left
|
||||
then
|
||||
return False;
|
||||
else
|
||||
return True;
|
||||
end if;
|
||||
end Equivalent_Keys;
|
||||
|
||||
-------------
|
||||
-- Exclude --
|
||||
-------------
|
||||
|
|
@ -608,6 +702,7 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
Node : Node_Access := Key_Keys.Ceiling (Tree, Key);
|
||||
Done : constant Node_Access := Key_Keys.Upper_Bound (Tree, Key);
|
||||
X : Node_Access;
|
||||
|
||||
begin
|
||||
while Node /= Done loop
|
||||
X := Node;
|
||||
|
|
@ -657,7 +752,7 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
(Left : Key_Type;
|
||||
Right : Node_Access) return Boolean is
|
||||
begin
|
||||
return Left > Right.Element;
|
||||
return Key (Right.Element) < Left;
|
||||
end Is_Greater_Key_Node;
|
||||
|
||||
----------------------
|
||||
|
|
@ -668,7 +763,7 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
(Left : Key_Type;
|
||||
Right : Node_Access) return Boolean is
|
||||
begin
|
||||
return Left < Right.Element;
|
||||
return Left < Key (Right.Element);
|
||||
end Is_Less_Key_Node;
|
||||
|
||||
-------------
|
||||
|
|
@ -720,6 +815,13 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Key (Position.Node.Element);
|
||||
end Key;
|
||||
|
||||
|
|
@ -786,9 +888,12 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element_Preserving_Key");
|
||||
|
||||
declare
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
K : Key_Type renames Key (E);
|
||||
K : constant Key_Type := Key (E);
|
||||
|
||||
B : Natural renames Tree.Busy;
|
||||
L : Natural renames Tree.Lock;
|
||||
|
|
@ -809,11 +914,7 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
L := L - 1;
|
||||
B := B - 1;
|
||||
|
||||
if K < E
|
||||
or else K > E
|
||||
then
|
||||
null;
|
||||
else
|
||||
if Equivalent_Keys (Left => K, Right => Key (E)) then
|
||||
return;
|
||||
end if;
|
||||
end;
|
||||
|
|
@ -853,6 +954,24 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
(Container : in out Set;
|
||||
New_Item : Element_Type;
|
||||
Position : out Cursor)
|
||||
is
|
||||
begin
|
||||
Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
New_Item,
|
||||
Position.Node);
|
||||
|
||||
Position.Container := Container'Unrestricted_Access;
|
||||
end Insert;
|
||||
|
||||
----------------------
|
||||
-- Insert_Sans_Hint --
|
||||
----------------------
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
|
@ -869,25 +988,23 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function New_Node return Node_Access is
|
||||
Node : constant Node_Access :=
|
||||
new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red,
|
||||
new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Element => New_Item);
|
||||
begin
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
-- Start of processing for Insert_Sans_Hint
|
||||
|
||||
begin
|
||||
Unconditional_Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
(Tree,
|
||||
New_Item,
|
||||
Position.Node);
|
||||
|
||||
Position.Container := Container'Unrestricted_Access;
|
||||
end Insert;
|
||||
Node);
|
||||
end Insert_Sans_Hint;
|
||||
|
||||
----------------------
|
||||
-- Insert_With_Hint --
|
||||
|
|
@ -1116,6 +1233,10 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Last_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.Last.Element;
|
||||
end Last_Element;
|
||||
|
||||
|
|
@ -1165,6 +1286,9 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
|
@ -1211,6 +1335,9 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
|
@ -1231,29 +1358,36 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type))
|
||||
is
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
S : Set renames Position.Container.all;
|
||||
T : Tree_Type renames S.Tree'Unrestricted_Access.all;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
begin
|
||||
Process (Position.Node.Element);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -1294,6 +1428,14 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
---------------------
|
||||
-- Replace_Element --
|
||||
---------------------
|
||||
|
|
@ -1336,6 +1478,11 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Element := Item;
|
||||
Node.Color := Red_Black_Trees.Red;
|
||||
Node.Parent := null;
|
||||
Node.Left := null;
|
||||
Node.Right := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1354,12 +1501,10 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
end Replace_Element;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Set;
|
||||
(Container : in out Set;
|
||||
Position : Cursor;
|
||||
By : Element_Type)
|
||||
New_Item : Element_Type)
|
||||
is
|
||||
Tree : Tree_Type renames Container.Tree'Unrestricted_Access.all;
|
||||
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
|
|
@ -1369,7 +1514,10 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Replace_Element (Tree, Position.Node, By);
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
Replace_Element (Container.Tree, Position.Node, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
---------------------
|
||||
|
|
@ -1514,6 +1662,19 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
return Set'(Controlled with Tree);
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
Tree : Tree_Type;
|
||||
Node : Node_Access;
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint (Tree, New_Item, Node);
|
||||
return Set'(Controlled with Tree);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1564,4 +1725,12 @@ package body Ada.Containers.Ordered_Multisets is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Ordered_Multisets;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -46,6 +46,8 @@ generic
|
|||
package Ada.Containers.Ordered_Multisets is
|
||||
pragma Preelaborate;
|
||||
|
||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
|
||||
|
||||
type Set is tagged private;
|
||||
|
||||
type Cursor is private;
|
||||
|
|
@ -58,6 +60,8 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Length (Container : Set) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Set) return Boolean;
|
||||
|
|
@ -66,18 +70,16 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type;
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : in out Set;
|
||||
Position : Cursor;
|
||||
New_Item : Element_Type);
|
||||
|
||||
procedure Query_Element
|
||||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type));
|
||||
|
||||
procedure Replace_Element
|
||||
(Container : Set;
|
||||
Position : Cursor;
|
||||
By : Element_Type);
|
||||
|
||||
procedure Move
|
||||
(Target : in out Set;
|
||||
Source : in out Set);
|
||||
procedure Move (Target : in out Set; Source : in out Set);
|
||||
|
||||
procedure Insert
|
||||
(Container : in out Set;
|
||||
|
|
@ -88,6 +90,16 @@ package Ada.Containers.Ordered_Multisets is
|
|||
(Container : in out Set;
|
||||
New_Item : Element_Type);
|
||||
|
||||
-- TODO: include Replace too???
|
||||
--
|
||||
-- procedure Replace
|
||||
-- (Container : in out Set;
|
||||
-- New_Item : Element_Type);
|
||||
|
||||
procedure Exclude
|
||||
(Container : in out Set;
|
||||
Item : Element_Type);
|
||||
|
||||
procedure Delete
|
||||
(Container : in out Set;
|
||||
Item : Element_Type);
|
||||
|
|
@ -100,10 +112,6 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
procedure Delete_Last (Container : in out Set);
|
||||
|
||||
procedure Exclude
|
||||
(Container : in out Set;
|
||||
Item : Element_Type);
|
||||
|
||||
procedure Union (Target : in out Set; Source : Set);
|
||||
|
||||
function Union (Left, Right : Set) return Set;
|
||||
|
|
@ -132,14 +140,6 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
|
||||
|
||||
function Contains (Container : Set; Item : Element_Type) return Boolean;
|
||||
|
||||
function Find (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Floor (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function First (Container : Set) return Cursor;
|
||||
|
||||
function First_Element (Container : Set) return Element_Type;
|
||||
|
|
@ -156,6 +156,14 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
procedure Previous (Position : in out Cursor);
|
||||
|
||||
function Find (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Floor (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
|
||||
|
||||
function Contains (Container : Set; Item : Element_Type) return Boolean;
|
||||
|
||||
function Has_Element (Position : Cursor) return Boolean;
|
||||
|
||||
function "<" (Left, Right : Cursor) return Boolean;
|
||||
|
|
@ -189,19 +197,23 @@ package Ada.Containers.Ordered_Multisets is
|
|||
Process : not null access procedure (Position : Cursor));
|
||||
|
||||
generic
|
||||
type Key_Type (<>) is limited private;
|
||||
type Key_Type (<>) is private;
|
||||
|
||||
with function Key (Element : Element_Type) return Key_Type;
|
||||
|
||||
with function "<" (Left : Key_Type; Right : Element_Type)
|
||||
return Boolean is <>;
|
||||
|
||||
with function ">" (Left : Key_Type; Right : Element_Type)
|
||||
return Boolean is <>;
|
||||
with function "<" (Left, Right : Key_Type) return Boolean is <>;
|
||||
|
||||
package Generic_Keys is
|
||||
|
||||
function Contains (Container : Set; Key : Key_Type) return Boolean;
|
||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
|
||||
|
||||
function Key (Position : Cursor) return Key_Type;
|
||||
|
||||
function Element (Container : Set; Key : Key_Type) return Element_Type;
|
||||
|
||||
procedure Exclude (Container : in out Set; Key : Key_Type);
|
||||
|
||||
procedure Delete (Container : in out Set; Key : Key_Type);
|
||||
|
||||
function Find (Container : Set; Key : Key_Type) return Cursor;
|
||||
|
||||
|
|
@ -209,27 +221,13 @@ package Ada.Containers.Ordered_Multisets is
|
|||
|
||||
function Ceiling (Container : Set; Key : Key_Type) return Cursor;
|
||||
|
||||
function Key (Position : Cursor) return Key_Type;
|
||||
|
||||
function Element (Container : Set; Key : Key_Type) return Element_Type;
|
||||
|
||||
procedure Delete (Container : in out Set; Key : Key_Type);
|
||||
|
||||
procedure Exclude (Container : in out Set; Key : Key_Type);
|
||||
|
||||
function "<" (Left : Cursor; Right : Key_Type) return Boolean;
|
||||
|
||||
function ">" (Left : Cursor; Right : Key_Type) return Boolean;
|
||||
|
||||
function "<" (Left : Key_Type; Right : Cursor) return Boolean;
|
||||
|
||||
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
|
||||
function Contains (Container : Set; Key : Key_Type) return Boolean;
|
||||
|
||||
procedure Update_Element_Preserving_Key
|
||||
(Container : in out Set;
|
||||
Position : Cursor;
|
||||
Process : not null access
|
||||
procedure (Element : in out Element_Type));
|
||||
procedure (Element : in out Element_Type));
|
||||
|
||||
procedure Iterate
|
||||
(Container : Set;
|
||||
|
|
@ -271,6 +269,7 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -280,9 +279,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -84,6 +84,14 @@ package body Ada.Containers.Ordered_Sets is
|
|||
function Copy_Node (Source : Node_Access) return Node_Access;
|
||||
pragma Inline (Copy_Node);
|
||||
|
||||
procedure Free (X : in out Node_Access);
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean);
|
||||
|
||||
procedure Insert_With_Hint
|
||||
(Dst_Tree : in out Tree_Type;
|
||||
Dst_Hint : Node_Access;
|
||||
|
|
@ -115,9 +123,6 @@ package body Ada.Containers.Ordered_Sets is
|
|||
-- Local Instantiations --
|
||||
--------------------------
|
||||
|
||||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
package Tree_Operations is
|
||||
new Red_Black_Trees.Generic_Operations (Tree_Types);
|
||||
|
||||
|
|
@ -154,16 +159,42 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function "<" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left.Node.Element < Right.Node.Element;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in ""<""");
|
||||
|
||||
return Left.Node.Element < Right;
|
||||
end "<";
|
||||
|
||||
function "<" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in ""<""");
|
||||
|
||||
return Left < Right.Node.Element;
|
||||
end "<";
|
||||
|
||||
|
|
@ -182,6 +213,18 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function ">" (Left, Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
-- L > R same as R < L
|
||||
|
||||
return Right.Node.Element < Left.Node.Element;
|
||||
|
|
@ -189,11 +232,25 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function ">" (Left : Element_Type; Right : Cursor) return Boolean is
|
||||
begin
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Right.Container.Tree, Right.Node),
|
||||
"bad Right cursor in "">""");
|
||||
|
||||
return Right.Node.Element < Left;
|
||||
end ">";
|
||||
|
||||
function ">" (Left : Cursor; Right : Element_Type) return Boolean is
|
||||
begin
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Left.Container.Tree, Left.Node),
|
||||
"bad Left cursor in "">""");
|
||||
|
||||
return Right < Left.Node.Element;
|
||||
end ">";
|
||||
|
||||
|
|
@ -287,6 +344,9 @@ package body Ada.Containers.Ordered_Sets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Delete");
|
||||
|
||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
|
||||
Free (Position.Node);
|
||||
Position.Container := null;
|
||||
|
|
@ -356,6 +416,13 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function Element (Position : Cursor) return Element_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Element");
|
||||
|
||||
return Position.Node.Element;
|
||||
end Element;
|
||||
|
||||
|
|
@ -455,6 +522,10 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function First_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.First = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.First.Element;
|
||||
end First_Element;
|
||||
|
||||
|
|
@ -474,6 +545,24 @@ package body Ada.Containers.Ordered_Sets is
|
|||
return Cursor'(Container'Unrestricted_Access, Node);
|
||||
end Floor;
|
||||
|
||||
----------
|
||||
-- Free --
|
||||
----------
|
||||
|
||||
procedure Free (X : in out Node_Access) is
|
||||
procedure Deallocate is
|
||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||
|
||||
begin
|
||||
if X /= null then
|
||||
X.Parent := X;
|
||||
X.Left := X;
|
||||
X.Right := X;
|
||||
|
||||
Deallocate (X);
|
||||
end if;
|
||||
end Free;
|
||||
|
||||
------------------
|
||||
-- Generic_Keys --
|
||||
------------------
|
||||
|
|
@ -550,13 +639,15 @@ package body Ada.Containers.Ordered_Sets is
|
|||
-- Element --
|
||||
-------------
|
||||
|
||||
function Element
|
||||
(Container : Set;
|
||||
Key : Key_Type) return Element_Type
|
||||
is
|
||||
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
|
||||
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;
|
||||
end if;
|
||||
|
||||
return Node.Element;
|
||||
end Element;
|
||||
|
||||
|
|
@ -649,6 +740,13 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function Key (Position : Cursor) return Key_Type is
|
||||
begin
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Key");
|
||||
|
||||
return Key (Position.Node.Element);
|
||||
end Key;
|
||||
|
||||
|
|
@ -691,6 +789,9 @@ package body Ada.Containers.Ordered_Sets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Update_Element_Preserving_Key");
|
||||
|
||||
declare
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
K : constant Key_Type := Key (E);
|
||||
|
|
@ -770,32 +871,6 @@ package body Ada.Containers.Ordered_Sets is
|
|||
Position : out Cursor;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Insert_Post is
|
||||
new Element_Keys.Generic_Insert_Post (New_Node);
|
||||
|
||||
procedure Insert_Sans_Hint is
|
||||
new Element_Keys.Generic_Conditional_Insert (Insert_Post);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
Node : constant Node_Access :=
|
||||
new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red,
|
||||
Element => New_Item);
|
||||
begin
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint
|
||||
(Container.Tree,
|
||||
|
|
@ -821,6 +896,48 @@ package body Ada.Containers.Ordered_Sets is
|
|||
end if;
|
||||
end Insert;
|
||||
|
||||
----------------------
|
||||
-- Insert_Sans_Hint --
|
||||
----------------------
|
||||
|
||||
procedure Insert_Sans_Hint
|
||||
(Tree : in out Tree_Type;
|
||||
New_Item : Element_Type;
|
||||
Node : out Node_Access;
|
||||
Inserted : out Boolean)
|
||||
is
|
||||
function New_Node return Node_Access;
|
||||
pragma Inline (New_Node);
|
||||
|
||||
procedure Insert_Post is
|
||||
new Element_Keys.Generic_Insert_Post (New_Node);
|
||||
|
||||
procedure Conditional_Insert_Sans_Hint is
|
||||
new Element_Keys.Generic_Conditional_Insert (Insert_Post);
|
||||
|
||||
--------------
|
||||
-- New_Node --
|
||||
--------------
|
||||
|
||||
function New_Node return Node_Access is
|
||||
begin
|
||||
return new Node_Type'(Parent => null,
|
||||
Left => null,
|
||||
Right => null,
|
||||
Color => Red_Black_Trees.Red,
|
||||
Element => New_Item);
|
||||
end New_Node;
|
||||
|
||||
-- Start of processing for Insert_Sans_Hint
|
||||
|
||||
begin
|
||||
Conditional_Insert_Sans_Hint
|
||||
(Tree,
|
||||
New_Item,
|
||||
Node,
|
||||
Inserted);
|
||||
end Insert_Sans_Hint;
|
||||
|
||||
----------------------
|
||||
-- Insert_With_Hint --
|
||||
----------------------
|
||||
|
|
@ -1012,6 +1129,10 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function Last_Element (Container : Set) return Element_Type is
|
||||
begin
|
||||
if Container.Tree.Last = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
return Container.Tree.Last.Element;
|
||||
end Last_Element;
|
||||
|
||||
|
|
@ -1055,6 +1176,9 @@ package body Ada.Containers.Ordered_Sets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Next");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Next (Position.Node);
|
||||
|
|
@ -1101,6 +1225,9 @@ package body Ada.Containers.Ordered_Sets is
|
|||
return No_Element;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Previous");
|
||||
|
||||
declare
|
||||
Node : constant Node_Access :=
|
||||
Tree_Operations.Previous (Position.Node);
|
||||
|
|
@ -1127,29 +1254,36 @@ package body Ada.Containers.Ordered_Sets is
|
|||
(Position : Cursor;
|
||||
Process : not null access procedure (Element : Element_Type))
|
||||
is
|
||||
E : Element_Type renames Position.Node.Element;
|
||||
|
||||
S : Set renames Position.Container.all;
|
||||
T : Tree_Type renames S.Tree'Unrestricted_Access.all;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
if Position.Node = null then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Position.Container.Tree, Position.Node),
|
||||
"bad cursor in Query_Element");
|
||||
|
||||
declare
|
||||
T : Tree_Type renames Position.Container.Tree;
|
||||
|
||||
B : Natural renames T.Busy;
|
||||
L : Natural renames T.Lock;
|
||||
|
||||
begin
|
||||
Process (E);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
B := B + 1;
|
||||
L := L + 1;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
begin
|
||||
Process (Position.Node.Element);
|
||||
exception
|
||||
when others =>
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
raise;
|
||||
end;
|
||||
|
||||
L := L - 1;
|
||||
B := B - 1;
|
||||
end;
|
||||
end Query_Element;
|
||||
|
||||
----------
|
||||
|
|
@ -1192,6 +1326,14 @@ package body Ada.Containers.Ordered_Sets is
|
|||
Read (Stream, Container.Tree);
|
||||
end Read;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Read;
|
||||
|
||||
-------------
|
||||
-- Replace --
|
||||
-------------
|
||||
|
|
@ -1254,6 +1396,11 @@ package body Ada.Containers.Ordered_Sets is
|
|||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Element := Item;
|
||||
Node.Color := Red;
|
||||
Node.Parent := null;
|
||||
Node.Right := null;
|
||||
Node.Left := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1294,6 +1441,11 @@ package body Ada.Containers.Ordered_Sets is
|
|||
|
||||
function New_Node return Node_Access is
|
||||
begin
|
||||
Node.Color := Red;
|
||||
Node.Parent := null;
|
||||
Node.Right := null;
|
||||
Node.Left := null;
|
||||
|
||||
return Node;
|
||||
end New_Node;
|
||||
|
||||
|
|
@ -1330,6 +1482,9 @@ package body Ada.Containers.Ordered_Sets is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Vet (Container.Tree, Position.Node),
|
||||
"bad cursor in Replace_Element");
|
||||
|
||||
Replace_Element (Container.Tree, Position.Node, New_Item);
|
||||
end Replace_Element;
|
||||
|
||||
|
|
@ -1436,6 +1591,20 @@ package body Ada.Containers.Ordered_Sets is
|
|||
return Set'(Controlled with Tree);
|
||||
end Symmetric_Difference;
|
||||
|
||||
------------
|
||||
-- To_Set --
|
||||
------------
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set is
|
||||
Tree : Tree_Type;
|
||||
Node : Node_Access;
|
||||
Inserted : Boolean;
|
||||
|
||||
begin
|
||||
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
|
||||
return Set'(Controlled with Tree);
|
||||
end To_Set;
|
||||
|
||||
-----------
|
||||
-- Union --
|
||||
-----------
|
||||
|
|
@ -1486,4 +1655,12 @@ package body Ada.Containers.Ordered_Sets is
|
|||
Write (Stream, Container.Tree);
|
||||
end Write;
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor)
|
||||
is
|
||||
begin
|
||||
raise Program_Error;
|
||||
end Write;
|
||||
|
||||
end Ada.Containers.Ordered_Sets;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -60,6 +60,8 @@ package Ada.Containers.Ordered_Sets is
|
|||
|
||||
function Equivalent_Sets (Left, Right : Set) return Boolean;
|
||||
|
||||
function To_Set (New_Item : Element_Type) return Set;
|
||||
|
||||
function Length (Container : Set) return Count_Type;
|
||||
|
||||
function Is_Empty (Container : Set) return Boolean;
|
||||
|
|
@ -255,6 +257,7 @@ private
|
|||
use Red_Black_Trees;
|
||||
use Tree_Types;
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Set_Access is access all Set;
|
||||
for Set_Access'Storage_Size use 0;
|
||||
|
|
@ -264,9 +267,19 @@ private
|
|||
Node : Node_Access;
|
||||
end record;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : Cursor);
|
||||
|
||||
use Ada.Streams;
|
||||
for Cursor'Write use Write;
|
||||
|
||||
procedure Read
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
Item : out Cursor);
|
||||
|
||||
for Cursor'Read use Read;
|
||||
|
||||
No_Element : constant Cursor := Cursor'(null, null);
|
||||
|
||||
procedure Write
|
||||
(Stream : access Root_Stream_Type'Class;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -49,91 +49,91 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
procedure Left_Rotate (Tree : in out Tree_Type; X : Node_Access);
|
||||
procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access);
|
||||
|
||||
---------------------
|
||||
-- Check_Invariant --
|
||||
---------------------
|
||||
-- ---------------------
|
||||
-- -- Check_Invariant --
|
||||
-- ---------------------
|
||||
|
||||
procedure Check_Invariant (Tree : Tree_Type) is
|
||||
Root : constant Node_Access := Tree.Root;
|
||||
|
||||
function Check (Node : Node_Access) return Natural;
|
||||
|
||||
-----------
|
||||
-- Check --
|
||||
-----------
|
||||
|
||||
function Check (Node : Node_Access) return Natural is
|
||||
begin
|
||||
if Node = null then
|
||||
return 0;
|
||||
end if;
|
||||
|
||||
if Color (Node) = Red then
|
||||
declare
|
||||
L : constant Node_Access := Left (Node);
|
||||
begin
|
||||
pragma Assert (L = null or else Color (L) = Black);
|
||||
null;
|
||||
end;
|
||||
|
||||
declare
|
||||
R : constant Node_Access := Right (Node);
|
||||
begin
|
||||
pragma Assert (R = null or else Color (R) = Black);
|
||||
null;
|
||||
end;
|
||||
|
||||
declare
|
||||
NL : constant Natural := Check (Left (Node));
|
||||
NR : constant Natural := Check (Right (Node));
|
||||
begin
|
||||
pragma Assert (NL = NR);
|
||||
return NL;
|
||||
end;
|
||||
end if;
|
||||
|
||||
declare
|
||||
NL : constant Natural := Check (Left (Node));
|
||||
NR : constant Natural := Check (Right (Node));
|
||||
begin
|
||||
pragma Assert (NL = NR);
|
||||
return NL + 1;
|
||||
end;
|
||||
end Check;
|
||||
|
||||
-- Start of processing for Check_Invariant
|
||||
|
||||
begin
|
||||
if Root = null then
|
||||
pragma Assert (Tree.First = null);
|
||||
pragma Assert (Tree.Last = null);
|
||||
pragma Assert (Tree.Length = 0);
|
||||
null;
|
||||
|
||||
else
|
||||
pragma Assert (Color (Root) = Black);
|
||||
pragma Assert (Tree.Length > 0);
|
||||
pragma Assert (Tree.Root /= null);
|
||||
pragma Assert (Tree.First /= null);
|
||||
pragma Assert (Tree.Last /= null);
|
||||
pragma Assert (Parent (Tree.Root) = null);
|
||||
pragma Assert ((Tree.Length > 1)
|
||||
or else (Tree.First = Tree.Last
|
||||
and Tree.First = Tree.Root));
|
||||
pragma Assert (Left (Tree.First) = null);
|
||||
pragma Assert (Right (Tree.Last) = null);
|
||||
|
||||
declare
|
||||
L : constant Node_Access := Left (Root);
|
||||
R : constant Node_Access := Right (Root);
|
||||
NL : constant Natural := Check (L);
|
||||
NR : constant Natural := Check (R);
|
||||
begin
|
||||
pragma Assert (NL = NR);
|
||||
null;
|
||||
end;
|
||||
end if;
|
||||
end Check_Invariant;
|
||||
-- procedure Check_Invariant (Tree : Tree_Type) is
|
||||
-- Root : constant Node_Access := Tree.Root;
|
||||
--
|
||||
-- function Check (Node : Node_Access) return Natural;
|
||||
--
|
||||
-- -----------
|
||||
-- -- Check --
|
||||
-- -----------
|
||||
--
|
||||
-- function Check (Node : Node_Access) return Natural is
|
||||
-- begin
|
||||
-- if Node = null then
|
||||
-- return 0;
|
||||
-- end if;
|
||||
--
|
||||
-- if Color (Node) = Red then
|
||||
-- declare
|
||||
-- L : constant Node_Access := Left (Node);
|
||||
-- begin
|
||||
-- pragma Assert (L = null or else Color (L) = Black);
|
||||
-- null;
|
||||
-- end;
|
||||
--
|
||||
-- declare
|
||||
-- R : constant Node_Access := Right (Node);
|
||||
-- begin
|
||||
-- pragma Assert (R = null or else Color (R) = Black);
|
||||
-- null;
|
||||
-- end;
|
||||
--
|
||||
-- declare
|
||||
-- NL : constant Natural := Check (Left (Node));
|
||||
-- NR : constant Natural := Check (Right (Node));
|
||||
-- begin
|
||||
-- pragma Assert (NL = NR);
|
||||
-- return NL;
|
||||
-- end;
|
||||
-- end if;
|
||||
--
|
||||
-- declare
|
||||
-- NL : constant Natural := Check (Left (Node));
|
||||
-- NR : constant Natural := Check (Right (Node));
|
||||
-- begin
|
||||
-- pragma Assert (NL = NR);
|
||||
-- return NL + 1;
|
||||
-- end;
|
||||
-- end Check;
|
||||
--
|
||||
-- -- Start of processing for Check_Invariant
|
||||
--
|
||||
-- begin
|
||||
-- if Root = null then
|
||||
-- pragma Assert (Tree.First = null);
|
||||
-- pragma Assert (Tree.Last = null);
|
||||
-- pragma Assert (Tree.Length = 0);
|
||||
-- null;
|
||||
--
|
||||
-- else
|
||||
-- pragma Assert (Color (Root) = Black);
|
||||
-- pragma Assert (Tree.Length > 0);
|
||||
-- pragma Assert (Tree.Root /= null);
|
||||
-- pragma Assert (Tree.First /= null);
|
||||
-- pragma Assert (Tree.Last /= null);
|
||||
-- pragma Assert (Parent (Tree.Root) = null);
|
||||
-- pragma Assert ((Tree.Length > 1)
|
||||
-- or else (Tree.First = Tree.Last
|
||||
-- and Tree.First = Tree.Root));
|
||||
-- pragma Assert (Left (Tree.First) = null);
|
||||
-- pragma Assert (Right (Tree.Last) = null);
|
||||
--
|
||||
-- declare
|
||||
-- L : constant Node_Access := Left (Root);
|
||||
-- R : constant Node_Access := Right (Root);
|
||||
-- NL : constant Natural := Check (L);
|
||||
-- NR : constant Natural := Check (R);
|
||||
-- begin
|
||||
-- pragma Assert (NL = NR);
|
||||
-- null;
|
||||
-- end;
|
||||
-- end if;
|
||||
-- end Check_Invariant;
|
||||
|
||||
------------------
|
||||
-- Delete_Fixup --
|
||||
|
|
@ -249,22 +249,22 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
pragma Assert (Tree.Length > 0);
|
||||
pragma Assert (Tree.Root /= null);
|
||||
pragma Assert (Tree.First /= null);
|
||||
pragma Assert (Tree.Last /= null);
|
||||
pragma Assert (Parent (Tree.Root) = null);
|
||||
pragma Assert ((Tree.Length > 1)
|
||||
or else (Tree.First = Tree.Last
|
||||
and then Tree.First = Tree.Root));
|
||||
pragma Assert ((Left (Node) = null)
|
||||
or else (Parent (Left (Node)) = Node));
|
||||
pragma Assert ((Right (Node) = null)
|
||||
or else (Parent (Right (Node)) = Node));
|
||||
pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
|
||||
or else ((Parent (Node) /= null) and then
|
||||
((Left (Parent (Node)) = Node)
|
||||
or else (Right (Parent (Node)) = Node))));
|
||||
-- pragma Assert (Tree.Length > 0);
|
||||
-- pragma Assert (Tree.Root /= null);
|
||||
-- pragma Assert (Tree.First /= null);
|
||||
-- pragma Assert (Tree.Last /= null);
|
||||
-- pragma Assert (Parent (Tree.Root) = null);
|
||||
-- pragma Assert ((Tree.Length > 1)
|
||||
-- or else (Tree.First = Tree.Last
|
||||
-- and then Tree.First = Tree.Root));
|
||||
-- pragma Assert ((Left (Node) = null)
|
||||
-- or else (Parent (Left (Node)) = Node));
|
||||
-- pragma Assert ((Right (Node) = null)
|
||||
-- or else (Parent (Right (Node)) = Node));
|
||||
-- pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
|
||||
-- or else ((Parent (Node) /= null) and then
|
||||
-- ((Left (Parent (Node)) = Node)
|
||||
-- or else (Right (Parent (Node)) = Node))));
|
||||
|
||||
if Left (Z) = null then
|
||||
if Right (Z) = null then
|
||||
|
|
@ -545,7 +545,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
P, X : Node_Access;
|
||||
|
||||
begin
|
||||
|
||||
if Right (Source_Root) /= null then
|
||||
Set_Right
|
||||
(Node => Target_Root,
|
||||
|
|
@ -586,7 +585,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
when others =>
|
||||
Delete_Tree (Target_Root);
|
||||
raise;
|
||||
|
||||
end Generic_Copy_Tree;
|
||||
|
||||
-------------------------
|
||||
|
|
@ -1049,4 +1047,106 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
Set_Parent (Y, X);
|
||||
end Right_Rotate;
|
||||
|
||||
---------
|
||||
-- Vet --
|
||||
---------
|
||||
|
||||
function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is
|
||||
begin
|
||||
if Node = null then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
if Parent (Node) = Node
|
||||
or else Left (Node) = Node
|
||||
or else Right (Node) = Node
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Tree.Length = 0
|
||||
or else Tree.Root = null
|
||||
or else Tree.First = null
|
||||
or else Tree.Last = null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Parent (Tree.Root) /= null then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Left (Tree.First) /= null then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Right (Tree.Last) /= null then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Tree.Length = 1 then
|
||||
if Tree.First /= Tree.Last
|
||||
or else Tree.First /= Tree.Root
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Node /= Tree.First then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Parent (Node) /= null
|
||||
or else Left (Node) /= null
|
||||
or else Right (Node) /= null
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
return True;
|
||||
end if;
|
||||
|
||||
if Tree.First = Tree.Last then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Tree.Length = 2 then
|
||||
if Tree.First /= Tree.Root
|
||||
and then Tree.Last /= Tree.Root
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Tree.First /= Node
|
||||
and then Tree.Last /= Node
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Left (Node) /= null
|
||||
and then Parent (Left (Node)) /= Node
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Right (Node) /= null
|
||||
and then Parent (Right (Node)) /= Node
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
if Parent (Node) = null then
|
||||
if Tree.Root /= Node then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
elsif Left (Parent (Node)) /= Node
|
||||
and then Right (Parent (Node)) /= Node
|
||||
then
|
||||
return False;
|
||||
end if;
|
||||
|
||||
return True;
|
||||
end Vet;
|
||||
|
||||
end Ada.Containers.Red_Black_Trees.Generic_Operations;
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
|
|
@ -56,7 +56,14 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is
|
|||
|
||||
function Max (Node : Node_Access) return Node_Access;
|
||||
|
||||
procedure Check_Invariant (Tree : Tree_Type);
|
||||
-- NOTE: The Check_Invariant operation was used during early
|
||||
-- development of the red-black tree. Now that the tree type
|
||||
-- implementation has matured, we don't really need Check_Invariant
|
||||
-- anymore.
|
||||
|
||||
-- procedure Check_Invariant (Tree : Tree_Type);
|
||||
|
||||
function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean;
|
||||
|
||||
function Next (Node : Node_Access) return Node_Access;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue