Commit 2368f04e by Matthew Heaney Committed by Arnaud Charlet

a-crbtgo.ads, [...]: Compiles against the spec for ordered maps described in…

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
parent 5e61ef09
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -63,49 +63,51 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -63,49 +63,51 @@ package Ada.Containers.Doubly_Linked_Lists is
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 procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out List;
Process : not null access procedure (Element : in out Element_Type)); Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Replace_Element
(Position : Cursor;
By : Element_Type);
procedure Move procedure Move
(Target : in out List; (Target : in out List;
Source : in out List); Source : in out List);
procedure Prepend procedure Insert
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Append procedure Insert
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Insert procedure Insert
(Container : in out List; (Container : in out List;
Before : Cursor; Before : Cursor;
New_Item : Element_Type; Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Insert procedure Prepend
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Insert procedure Append
(Container : in out List; (Container : in out List;
Before : Cursor; New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Delete procedure Delete
...@@ -121,21 +123,11 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -121,21 +123,11 @@ package Ada.Containers.Doubly_Linked_Lists is
(Container : in out List; (Container : in out List;
Count : Count_Type := 1); Count : Count_Type := 1);
generic procedure Reverse_Elements (Container : in out List);
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); procedure Swap
(Container : in out List;
end Generic_Sorting; I, J : Cursor);
procedure Reverse_List (Container : in out List);
procedure Swap (I, J : Cursor);
procedure Swap_Links procedure Swap_Links
(Container : in out List; (Container : in out List;
...@@ -149,13 +141,13 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -149,13 +141,13 @@ package Ada.Containers.Doubly_Linked_Lists is
procedure Splice procedure Splice
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor); Source : in out List;
Position : in out Cursor);
procedure Splice procedure Splice
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Source : in out List; Position : Cursor);
Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
...@@ -165,9 +157,13 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -165,9 +157,13 @@ package Ada.Containers.Doubly_Linked_Lists is
function Last_Element (Container : List) return Element_Type; function Last_Element (Container : List) return Element_Type;
function Contains function Next (Position : Cursor) return Cursor;
(Container : List;
Item : Element_Type) return Boolean; procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Find function Find
(Container : List; (Container : List;
...@@ -179,13 +175,9 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -179,13 +175,9 @@ package Ada.Containers.Doubly_Linked_Lists is
Item : Element_Type; Item : Element_Type;
Position : Cursor := No_Element) return Cursor; Position : Cursor := No_Element) return Cursor;
function Next (Position : Cursor) return Cursor; function Contains
(Container : List;
function Previous (Position : Cursor) return Cursor; Item : Element_Type) return Boolean;
procedure Next (Position : in out Cursor);
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -197,6 +189,18 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -197,6 +189,18 @@ package Ada.Containers.Doubly_Linked_Lists is
(Container : List; (Container : List;
Process : not null access procedure (Position : Cursor)); 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 private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
...@@ -248,6 +252,18 @@ private ...@@ -248,6 +252,18 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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); No_Element : constant Cursor := Cursor'(null, null);
end Ada.Containers.Doubly_Linked_Lists; end Ada.Containers.Doubly_Linked_Lists;
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -62,46 +62,47 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -62,46 +62,47 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
procedure Clear (Container : in out List); procedure Clear (Container : in out List);
function Element (Position : Cursor) function Element (Position : Cursor) return Element_Type;
return Element_Type;
procedure Replace_Element
(Container : in out List;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out List;
Process : not null access procedure (Element : in out Element_Type)); Position : Cursor;
Process : not null access procedure (Element : in out Element_Type));
procedure Replace_Element
(Position : Cursor;
By : Element_Type);
procedure Move procedure Move
(Target : in out List; (Target : in out List;
Source : in out List); Source : in out List);
procedure Prepend procedure Insert
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Append procedure Insert
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Insert procedure Prepend
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Insert procedure Append
(Container : in out List; (Container : in out List;
Before : Cursor;
New_Item : Element_Type; New_Item : Element_Type;
Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Delete procedure Delete
...@@ -117,21 +118,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -117,21 +118,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
(Container : in out List; (Container : in out List;
Count : Count_Type := 1); Count : Count_Type := 1);
generic procedure Reverse_Elements (Container : in out List);
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;
procedure Reverse_List (Container : in out List); procedure Swap (Container : in out List; I, J : Cursor);
procedure Swap (I, J : Cursor);
procedure Swap_Links (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 ...@@ -143,13 +132,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
procedure Splice procedure Splice
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Position : Cursor); Source : in out List;
Position : in out Cursor);
procedure Splice procedure Splice
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Source : in out List; Position : Cursor);
Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
...@@ -159,9 +148,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -159,9 +148,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
function Last_Element (Container : List) return Element_Type; function Last_Element (Container : List) return Element_Type;
function Contains function Next (Position : Cursor) return Cursor;
(Container : List;
Item : Element_Type) return Boolean; procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Find function Find
(Container : List; (Container : List;
...@@ -173,13 +166,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -173,13 +166,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Item : Element_Type; Item : Element_Type;
Position : Cursor := No_Element) return Cursor; Position : Cursor := No_Element) return Cursor;
function Next (Position : Cursor) return Cursor; function Contains
(Container : List;
function Previous (Position : Cursor) return Cursor; Item : Element_Type) return Boolean;
procedure Next (Position : in out Cursor);
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -191,6 +180,18 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -191,6 +180,18 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
(Container : List; (Container : List;
Process : not null access procedure (Position : Cursor)); 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 private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
...@@ -244,6 +245,18 @@ private ...@@ -244,6 +245,18 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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); No_Element : constant Cursor := Cursor'(null, null);
end Ada.Containers.Indefinite_Doubly_Linked_Lists; end Ada.Containers.Indefinite_Doubly_Linked_Lists;
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -713,6 +713,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -713,6 +713,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Read_Nodes (Stream, Container.HT); Read_Nodes (Stream, Container.HT);
end Read; end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
end Read;
--------------- ---------------
-- Read_Node -- -- Read_Node --
--------------- ---------------
...@@ -787,7 +795,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -787,7 +795,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
-- Replace_Element -- -- 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 begin
pragma Assert (Vet (Position), "bad cursor in Replace_Element"); pragma Assert (Vet (Position), "bad cursor in Replace_Element");
...@@ -795,6 +807,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -795,6 +807,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
end if;
if Position.Container.HT.Lock > 0 then if Position.Container.HT.Lock > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -803,7 +819,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -803,7 +819,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
X : Element_Access := Position.Node.Element; X : Element_Access := Position.Node.Element;
begin begin
Position.Node.Element := new Element_Type'(By); Position.Node.Element := new Element_Type'(New_Item);
Free_Element (X); Free_Element (X);
end; end;
end Replace_Element; end Replace_Element;
...@@ -834,9 +850,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -834,9 +850,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
-------------------- --------------------
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access procedure (Key : Key_Type; Position : Cursor;
Element : in out Element_Type)) Process : not null access procedure (Key : Key_Type;
Element : in out Element_Type))
is is
begin begin
pragma Assert (Vet (Position), "bad cursor in Update_Element"); pragma Assert (Vet (Position), "bad cursor in Update_Element");
...@@ -845,9 +862,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -845,9 +862,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
end if;
declare declare
M : Map renames Position.Container.all; HT : Hash_Table_Type renames Container.HT;
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
B : Natural renames HT.Busy; B : Natural renames HT.Busy;
L : Natural renames HT.Lock; L : Natural renames HT.Lock;
...@@ -859,7 +879,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -859,7 +879,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
declare declare
K : Key_Type renames Position.Node.Key.all; K : Key_Type renames Position.Node.Key.all;
E : Element_Type renames Position.Node.Element.all; E : Element_Type renames Position.Node.Element.all;
begin begin
Process (K, E); Process (K, E);
exception exception
...@@ -951,6 +970,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -951,6 +970,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
Write_Nodes (Stream, Container.HT); Write_Nodes (Stream, Container.HT);
end Write; end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
end Write;
---------------- ----------------
-- Write_Node -- -- Write_Node --
---------------- ----------------
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -57,6 +57,12 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -57,6 +57,12 @@ package Ada.Containers.Indefinite_Hashed_Maps is
function "=" (Left, Right : Map) return Boolean; 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 Length (Container : Map) return Count_Type;
function Is_Empty (Container : Map) return Boolean; function Is_Empty (Container : Map) return Boolean;
...@@ -67,20 +73,22 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -67,20 +73,22 @@ package Ada.Containers.Indefinite_Hashed_Maps is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Map;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Key : Key_Type; Process : not null access procedure (Key : Key_Type;
Element : Element_Type)); Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access procedure (Key : Key_Type; Position : Cursor;
Process : not null access procedure (Key : Key_Type;
Element : in out Element_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 Move (Target : in out Map; Source : in out Map);
procedure Insert procedure Insert
...@@ -105,29 +113,11 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -105,29 +113,11 @@ package Ada.Containers.Indefinite_Hashed_Maps is
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Delete procedure Exclude (Container : in out Map; Key : Key_Type);
(Container : in out Map;
Key : Key_Type);
procedure Delete procedure Delete (Container : in out Map; Key : Key_Type);
(Container : in out Map;
Position : in out Cursor);
procedure Exclude procedure Delete (Container : in out Map; Position : in out Cursor);
(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 First (Container : Map) return Cursor;
...@@ -135,29 +125,24 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -135,29 +125,24 @@ package Ada.Containers.Indefinite_Hashed_Maps is
procedure Next (Position : in out 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 Has_Element (Position : Cursor) return Boolean;
function Equivalent_Keys (Left, Right : Cursor) function Equivalent_Keys (Left, Right : Cursor) return Boolean;
return Boolean;
function Equivalent_Keys function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
(Left : Cursor;
Right : Key_Type) return Boolean;
function Equivalent_Keys function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
(Left : Key_Type;
Right : Cursor) return Boolean;
procedure Iterate procedure Iterate
(Container : Map; (Container : Map;
Process : not null access procedure (Position : Cursor)); 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 private
pragma Inline ("="); pragma Inline ("=");
pragma Inline (Length); pragma Inline (Length);
...@@ -194,6 +179,7 @@ private ...@@ -194,6 +179,7 @@ private
use HT_Types; use HT_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
procedure Adjust (Container : in out Map); procedure Adjust (Container : in out Map);
...@@ -208,12 +194,22 @@ private ...@@ -208,12 +194,22 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 := No_Element : constant Cursor :=
(Container => null, (Container => null,
Node => null); Node => null);
use Ada.Streams;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
Container : Map); Container : Map);
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -73,6 +73,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -73,6 +73,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function Hash_Node (Node : Node_Access) return Hash_Type; function Hash_Node (Node : Node_Access) return Hash_Type;
pragma Inline (Hash_Node); 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; function Is_In (HT : Hash_Table_Type; Key : Node_Access) return Boolean;
pragma Inline (Is_In); pragma Inline (Is_In);
...@@ -326,13 +332,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -326,13 +332,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
if not Is_In (Right.HT, L_Node) then if not Is_In (Right.HT, L_Node) then
declare declare
Indx : constant Hash_Type := Src : Element_Type renames L_Node.Element.all;
Hash (L_Node.Element.all) mod Buckets'Length; Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
Bucket : Node_Access renames Buckets (Indx); Bucket : Node_Access renames Buckets (Indx);
Tgt : Element_Access := new Element_Type'(Src);
begin begin
Bucket := new Node_Type'(L_Node.Element, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception
when others =>
Free_Element (Tgt);
raise;
end; end;
Length := Length + 1; Length := Length + 1;
...@@ -644,6 +653,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -644,6 +653,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Position : out Cursor; Position : out Cursor;
Inserted : out Boolean) Inserted : out Boolean)
is 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; function New_Node (Next : Node_Access) return Node_Access;
pragma Inline (New_Node); pragma Inline (New_Node);
...@@ -665,8 +700,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -665,8 +700,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
raise; raise;
end New_Node; end New_Node;
HT : Hash_Table_Type renames Container.HT;
-- Start of processing for Insert -- Start of processing for Insert
begin begin
...@@ -674,30 +707,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -674,30 +707,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
HT_Ops.Reserve_Capacity (HT, 1); HT_Ops.Reserve_Capacity (HT, 1);
end if; end if;
Local_Insert (HT, New_Item, Position.Node, Inserted); Local_Insert (HT, New_Item, Node, Inserted);
if Inserted if Inserted
and then HT.Length > HT_Ops.Capacity (HT) and then HT.Length > HT_Ops.Capacity (HT)
then then
HT_Ops.Reserve_Capacity (HT, HT.Length); HT_Ops.Reserve_Capacity (HT, HT.Length);
end if; 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; end Insert;
------------------ ------------------
...@@ -787,13 +803,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -787,13 +803,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
begin begin
if Is_In (Right.HT, L_Node) then if Is_In (Right.HT, L_Node) then
declare declare
Indx : constant Hash_Type := Src : Element_Type renames L_Node.Element.all;
Hash (L_Node.Element.all) mod Buckets'Length;
Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
Bucket : Node_Access renames Buckets (Indx); Bucket : Node_Access renames Buckets (Indx);
Tgt : Element_Access := new Element_Type'(Src);
begin begin
Bucket := new Node_Type'(L_Node.Element, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception
when others =>
Free_Element (Tgt);
raise;
end; end;
Length := Length + 1; Length := Length + 1;
...@@ -1040,6 +1063,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1040,6 +1063,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Read_Nodes (Stream, Container.HT); Read_Nodes (Stream, Container.HT);
end Read; end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
end Read;
--------------- ---------------
-- Read_Node -- -- Read_Node --
--------------- ---------------
...@@ -1502,6 +1533,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1502,6 +1533,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
return (Controlled with HT => (Buckets, Length, 0, 0)); return (Controlled with HT => (Buckets, Length, 0, 0));
end Symmetric_Difference; 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 -- -- Union --
----------- -----------
...@@ -1609,13 +1654,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1609,13 +1654,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
------------- -------------
procedure Process (L_Node : Node_Access) is procedure Process (L_Node : Node_Access) is
J : constant Hash_Type := Src : Element_Type renames L_Node.Element.all;
Hash (L_Node.Element.all) mod Buckets'Length;
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
Bucket : Node_Access renames Buckets (J); Bucket : Node_Access renames Buckets (J);
Tgt : Element_Access := new Element_Type'(Src);
begin begin
Bucket := new Node_Type'(L_Node.Element, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception
when others =>
Free_Element (Tgt);
raise;
end Process; end Process;
-- Start of processing for Process -- Start of processing for Process
...@@ -1751,6 +1803,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1751,6 +1803,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Write_Nodes (Stream, Container.HT); Write_Nodes (Stream, Container.HT);
end Write; end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
end Write;
---------------- ----------------
-- Write_Node -- -- Write_Node --
---------------- ----------------
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -63,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -63,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Equivalent_Sets (Left, Right : Set) return Boolean; function Equivalent_Sets (Left, Right : Set) return Boolean;
function To_Set (New_Item : Element_Type) return Set;
function Capacity (Container : Set) return Count_Type; function Capacity (Container : Set) return Count_Type;
procedure Reserve_Capacity procedure Reserve_Capacity
...@@ -225,6 +227,7 @@ private ...@@ -225,6 +227,7 @@ private
use HT_Types; use HT_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -235,12 +238,22 @@ private ...@@ -235,12 +238,22 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 := No_Element : constant Cursor :=
(Container => null, (Container => null,
Node => null); Node => null);
use Ada.Streams;
procedure Write procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
Container : Set); Container : Set);
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -40,16 +40,16 @@ with Ada.Streams; ...@@ -40,16 +40,16 @@ with Ada.Streams;
generic generic
type Key_Type (<>) is private; type Key_Type (<>) is private;
type Element_Type (<>) is private; type Element_Type (<>) is private;
with function "<" (Left, Right : Key_Type) return Boolean is <>; with function "<" (Left, Right : Key_Type) return Boolean is <>;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Indefinite_Ordered_Maps is package Ada.Containers.Indefinite_Ordered_Maps is
pragma Preelaborate; pragma Preelaborate;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private; type Map is tagged private;
type Cursor is private; type Cursor is private;
...@@ -70,17 +70,21 @@ package Ada.Containers.Indefinite_Ordered_Maps is ...@@ -70,17 +70,21 @@ package Ada.Containers.Indefinite_Ordered_Maps is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Map;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Key : Key_Type; Process : not null access procedure (Key : Key_Type;
Element : Element_Type)); Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access procedure (Key : Key_Type; Position : Cursor;
Element : in out Element_Type)); 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 Move (Target : in out Map; Source : in out Map);
...@@ -106,54 +110,28 @@ package Ada.Containers.Indefinite_Ordered_Maps is ...@@ -106,54 +110,28 @@ package Ada.Containers.Indefinite_Ordered_Maps is
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Delete procedure Exclude (Container : in out Map; Key : Key_Type);
(Container : in out Map;
Key : Key_Type);
procedure Delete procedure Delete (Container : in out Map; Key : Key_Type);
(Container : in out Map;
Position : in out Cursor); procedure Delete (Container : in out Map; Position : in out Cursor);
procedure Delete_First (Container : in out Map); procedure Delete_First (Container : in out Map);
procedure Delete_Last (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 (Container : Map) return Cursor;
function First_Key (Container : Map) return Key_Type;
function First_Element (Container : Map) return Element_Type; function First_Element (Container : Map) return Element_Type;
function Last (Container : Map) return Cursor; function First_Key (Container : Map) return Key_Type;
function Last_Key (Container : Map) return Key_Type; function Last (Container : Map) return Cursor;
function Last_Element (Container : Map) return Element_Type; function Last_Element (Container : Map) return Element_Type;
function Last_Key (Container : Map) return Key_Type;
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
...@@ -162,6 +140,16 @@ package Ada.Containers.Indefinite_Ordered_Maps is ...@@ -162,6 +140,16 @@ package Ada.Containers.Indefinite_Ordered_Maps is
procedure Previous (Position : in out Cursor); 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 Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -216,8 +204,9 @@ private ...@@ -216,8 +204,9 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; 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; for Map_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -225,9 +214,19 @@ private ...@@ -225,9 +214,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -47,6 +47,8 @@ generic ...@@ -47,6 +47,8 @@ generic
package Ada.Containers.Indefinite_Ordered_Multisets is package Ada.Containers.Indefinite_Ordered_Multisets is
pragma Preelaborate; pragma Preelaborate;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
type Set is tagged private; type Set is tagged private;
type Cursor is private; type Cursor is private;
...@@ -59,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -59,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
function Equivalent_Sets (Left, Right : Set) return Boolean; 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 Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean; function Is_Empty (Container : Set) return Boolean;
...@@ -67,15 +71,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -67,15 +71,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); 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 procedure Insert
...@@ -85,6 +89,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -85,6 +89,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
procedure Insert (Container : in out Set; New_Item : Element_Type); 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; Item : Element_Type);
procedure Delete (Container : in out Set; Position : in out Cursor); procedure Delete (Container : in out Set; Position : in out Cursor);
...@@ -93,10 +105,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -93,10 +105,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
procedure Delete_Last (Container : in out Set); 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; function Union (Left, Right : Set) return Set;
...@@ -124,14 +133,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -124,14 +133,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; 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 (Container : Set) return Cursor;
function First_Element (Container : Set) return Element_Type; function First_Element (Container : Set) return Element_Type;
...@@ -148,6 +149,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -148,6 +149,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
procedure Previous (Position : in out Cursor); 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 Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -181,42 +190,31 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -181,42 +190,31 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
generic generic
type Key_Type (<>) is private;
type Key_Type (<>) is limited private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function "<" (Left : Key_Type; Right : Element_Type) with function "<" (Left, Right : Key_Type) return Boolean is <>;
return Boolean is <>;
with function ">" (Left : Key_Type; Right : Element_Type)
return Boolean is <>;
package Generic_Keys is package Generic_Keys is
function Contains (Container : Set; Key : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
function Find (Container : Set; Key : Key_Type) return Cursor;
function Floor (Container : Set; Key : Key_Type) return Cursor;
function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_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); procedure Exclude (Container : in out Set; Key : Key_Type);
function "<" (Left : Cursor; Right : Key_Type) return Boolean; procedure Delete (Container : in out Set; Key : Key_Type);
function ">" (Left : Cursor; Right : Key_Type) return Boolean; function Find (Container : Set; Key : Key_Type) return Cursor;
function "<" (Left : Key_Type; Right : Cursor) return Boolean; function Floor (Container : Set; Key : Key_Type) return Cursor;
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
...@@ -266,6 +264,7 @@ private ...@@ -266,6 +264,7 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -275,9 +274,19 @@ private ...@@ -275,9 +274,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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); procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -61,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Sets is ...@@ -61,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Sets is
function Equivalent_Sets (Left, Right : Set) return Boolean; 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 Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean; function Is_Empty (Container : Set) return Boolean;
...@@ -266,6 +268,7 @@ private ...@@ -266,6 +268,7 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -275,9 +278,19 @@ private ...@@ -275,9 +278,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -624,6 +624,7 @@ package body Ada.Containers.Hashed_Maps is ...@@ -624,6 +624,7 @@ package body Ada.Containers.Hashed_Maps is
declare declare
HT : Hash_Table_Type renames Position.Container.HT; HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node); Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
begin begin
if Node = null then if Node = null then
return No_Element; return No_Element;
...@@ -695,6 +696,14 @@ package body Ada.Containers.Hashed_Maps is ...@@ -695,6 +696,14 @@ package body Ada.Containers.Hashed_Maps is
Read_Nodes (Stream, Container.HT); Read_Nodes (Stream, Container.HT);
end Read; end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
end Read;
--------------- ---------------
-- Read_Node -- -- Read_Node --
--------------- ---------------
...@@ -743,7 +752,11 @@ package body Ada.Containers.Hashed_Maps is ...@@ -743,7 +752,11 @@ package body Ada.Containers.Hashed_Maps is
-- Replace_Element -- -- 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 begin
pragma Assert (Vet (Position), "bad cursor in Replace_Element"); pragma Assert (Vet (Position), "bad cursor in Replace_Element");
...@@ -751,11 +764,15 @@ package body Ada.Containers.Hashed_Maps is ...@@ -751,11 +764,15 @@ package body Ada.Containers.Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Container /= Container'Unrestricted_Access then
raise Program_Error;
end if;
if Position.Container.HT.Lock > 0 then if Position.Container.HT.Lock > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
Position.Node.Element := By; Position.Node.Element := New_Item;
end Replace_Element; end Replace_Element;
---------------------- ----------------------
...@@ -784,9 +801,10 @@ package body Ada.Containers.Hashed_Maps is ...@@ -784,9 +801,10 @@ package body Ada.Containers.Hashed_Maps is
-------------------- --------------------
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access procedure (Key : Key_Type; Position : Cursor;
Element : in out Element_Type)) Process : not null access procedure (Key : Key_Type;
Element : in out Element_Type))
is is
begin begin
pragma Assert (Vet (Position), "bad cursor in Update_Element"); pragma Assert (Vet (Position), "bad cursor in Update_Element");
...@@ -795,12 +813,14 @@ package body Ada.Containers.Hashed_Maps is ...@@ -795,12 +813,14 @@ package body Ada.Containers.Hashed_Maps is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
declare if Position.Container /= Container'Unrestricted_Access then
M : Map renames Position.Container.all; raise Program_Error;
HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all; end if;
B : Natural renames HT.Busy; declare
L : Natural renames HT.Lock; HT : Hash_Table_Type renames Container.HT;
B : Natural renames HT.Busy;
L : Natural renames HT.Lock;
begin begin
B := B + 1; B := B + 1;
...@@ -809,7 +829,6 @@ package body Ada.Containers.Hashed_Maps is ...@@ -809,7 +829,6 @@ package body Ada.Containers.Hashed_Maps is
declare declare
K : Key_Type renames Position.Node.Key; K : Key_Type renames Position.Node.Key;
E : Element_Type renames Position.Node.Element; E : Element_Type renames Position.Node.Element;
begin begin
Process (K, E); Process (K, E);
exception exception
...@@ -891,6 +910,14 @@ package body Ada.Containers.Hashed_Maps is ...@@ -891,6 +910,14 @@ package body Ada.Containers.Hashed_Maps is
Write_Nodes (Stream, Container.HT); Write_Nodes (Stream, Container.HT);
end Write; end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
end Write;
---------------- ----------------
-- Write_Node -- -- Write_Node --
---------------- ----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -39,13 +39,10 @@ with Ada.Finalization; ...@@ -39,13 +39,10 @@ with Ada.Finalization;
generic generic
type Key_Type is private; type Key_Type is private;
type Element_Type is private; type Element_Type is private;
with function Hash (Key : Key_Type) return Hash_Type; with function Hash (Key : Key_Type) return Hash_Type;
with function Equivalent_Keys (Left, Right : Key_Type) return Boolean; with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Hashed_Maps is package Ada.Containers.Hashed_Maps is
...@@ -61,6 +58,11 @@ package Ada.Containers.Hashed_Maps is ...@@ -61,6 +58,11 @@ package Ada.Containers.Hashed_Maps is
function "=" (Left, Right : Map) return Boolean; 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 Length (Container : Map) return Count_Type;
function Is_Empty (Container : Map) return Boolean; function Is_Empty (Container : Map) return Boolean;
...@@ -71,18 +73,22 @@ package Ada.Containers.Hashed_Maps is ...@@ -71,18 +73,22 @@ package Ada.Containers.Hashed_Maps is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Map;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access Process : not null access
procedure (Key : Key_Type; Element : Element_Type)); procedure (Key : Key_Type; Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type)); 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 Move (Target : in out Map; Source : in out Map);
procedure Insert procedure Insert
...@@ -113,17 +119,11 @@ package Ada.Containers.Hashed_Maps is ...@@ -113,17 +119,11 @@ package Ada.Containers.Hashed_Maps is
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_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); procedure Exclude (Container : in out Map; Key : Key_Type);
function Contains (Container : Map; Key : Key_Type) return Boolean; procedure Delete (Container : in out Map; Key : Key_Type);
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; function First (Container : Map) return Cursor;
...@@ -131,6 +131,12 @@ package Ada.Containers.Hashed_Maps is ...@@ -131,6 +131,12 @@ package Ada.Containers.Hashed_Maps is
procedure Next (Position : in out 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 Has_Element (Position : Cursor) return Boolean;
function Equivalent_Keys (Left, Right : Cursor) return Boolean; function Equivalent_Keys (Left, Right : Cursor) return Boolean;
...@@ -143,11 +149,6 @@ package Ada.Containers.Hashed_Maps is ...@@ -143,11 +149,6 @@ package Ada.Containers.Hashed_Maps is
(Container : Map; (Container : Map;
Process : not null access procedure (Position : Cursor)); 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 private
pragma Inline ("="); pragma Inline ("=");
pragma Inline (Length); pragma Inline (Length);
...@@ -211,6 +212,18 @@ private ...@@ -211,6 +212,18 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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); No_Element : constant Cursor := (Container => null, Node => null);
end Ada.Containers.Hashed_Maps; end Ada.Containers.Hashed_Maps;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -72,6 +72,12 @@ package body Ada.Containers.Hashed_Sets is ...@@ -72,6 +72,12 @@ package body Ada.Containers.Hashed_Sets is
function Hash_Node (Node : Node_Access) return Hash_Type; function Hash_Node (Node : Node_Access) return Hash_Type;
pragma Inline (Hash_Node); 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 function Is_In
(HT : Hash_Table_Type; (HT : Hash_Table_Type;
Key : Node_Access) return Boolean; Key : Node_Access) return Boolean;
...@@ -595,6 +601,32 @@ package body Ada.Containers.Hashed_Sets is ...@@ -595,6 +601,32 @@ package body Ada.Containers.Hashed_Sets is
Position : out Cursor; Position : out Cursor;
Inserted : out Boolean) Inserted : out Boolean)
is 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; function New_Node (Next : Node_Access) return Node_Access;
pragma Inline (New_Node); pragma Inline (New_Node);
...@@ -606,13 +638,10 @@ package body Ada.Containers.Hashed_Sets is ...@@ -606,13 +638,10 @@ package body Ada.Containers.Hashed_Sets is
-------------- --------------
function New_Node (Next : Node_Access) return Node_Access is function New_Node (Next : Node_Access) return Node_Access is
Node : constant Node_Access := new Node_Type'(New_Item, Next);
begin begin
return Node; return new Node_Type'(New_Item, Next);
end New_Node; end New_Node;
HT : Hash_Table_Type renames Container.HT;
-- Start of processing for Insert -- Start of processing for Insert
begin begin
...@@ -620,30 +649,13 @@ package body Ada.Containers.Hashed_Sets is ...@@ -620,30 +649,13 @@ package body Ada.Containers.Hashed_Sets is
HT_Ops.Reserve_Capacity (HT, 1); HT_Ops.Reserve_Capacity (HT, 1);
end if; end if;
Local_Insert (HT, New_Item, Position.Node, Inserted); Local_Insert (HT, New_Item, Node, Inserted);
if Inserted if Inserted
and then HT.Length > HT_Ops.Capacity (HT) and then HT.Length > HT_Ops.Capacity (HT)
then then
HT_Ops.Reserve_Capacity (HT, HT.Length); HT_Ops.Reserve_Capacity (HT, HT.Length);
end if; 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; end Insert;
------------------ ------------------
...@@ -970,6 +982,14 @@ package body Ada.Containers.Hashed_Sets is ...@@ -970,6 +982,14 @@ package body Ada.Containers.Hashed_Sets is
Read_Nodes (Stream, Container.HT); Read_Nodes (Stream, Container.HT);
end Read; end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
Item : out Cursor)
is
begin
raise Program_Error;
end Read;
--------------- ---------------
-- Read_Node -- -- Read_Node --
--------------- ---------------
...@@ -1366,6 +1386,20 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1366,6 +1386,20 @@ package body Ada.Containers.Hashed_Sets is
return (Controlled with HT => (Buckets, Length, 0, 0)); return (Controlled with HT => (Buckets, Length, 0, 0));
end Symmetric_Difference; 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 -- -- Union --
----------- -----------
...@@ -1595,6 +1629,14 @@ package body Ada.Containers.Hashed_Sets is ...@@ -1595,6 +1629,14 @@ package body Ada.Containers.Hashed_Sets is
Write_Nodes (Stream, Container.HT); Write_Nodes (Stream, Container.HT);
end Write; end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
Item : Cursor)
is
begin
raise Program_Error;
end Write;
---------------- ----------------
-- Write_Node -- -- Write_Node --
---------------- ----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -62,6 +62,8 @@ package Ada.Containers.Hashed_Sets is ...@@ -62,6 +62,8 @@ package Ada.Containers.Hashed_Sets is
function Equivalent_Sets (Left, Right : Set) return Boolean; function Equivalent_Sets (Left, Right : Set) return Boolean;
function To_Set (New_Item : Element_Type) return Set;
function Capacity (Container : Set) return Count_Type; function Capacity (Container : Set) return Count_Type;
procedure Reserve_Capacity procedure Reserve_Capacity
...@@ -222,6 +224,7 @@ private ...@@ -222,6 +224,7 @@ private
use HT_Types; use HT_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -232,9 +235,19 @@ private ...@@ -232,9 +235,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -38,7 +38,6 @@ with Ada.Streams; ...@@ -38,7 +38,6 @@ with Ada.Streams;
generic generic
type Index_Type is range <>; type Index_Type is range <>;
type Element_Type (<>) is private; type Element_Type (<>) is private;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
...@@ -52,8 +51,6 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -52,8 +51,6 @@ package Ada.Containers.Indefinite_Vectors is
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
subtype Index_Subtype is Index_Type;
type Vector is tagged private; type Vector is tagged private;
type Cursor is private; type Cursor is private;
...@@ -62,6 +59,8 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -62,6 +59,8 @@ package Ada.Containers.Indefinite_Vectors is
No_Element : constant Cursor; No_Element : constant Cursor;
function "=" (Left, Right : Vector) return Boolean;
function To_Vector (Length : Count_Type) return Vector; function To_Vector (Length : Count_Type) return Vector;
function To_Vector function To_Vector
...@@ -76,8 +75,6 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -76,8 +75,6 @@ package Ada.Containers.Indefinite_Vectors is
function "&" (Left, Right : Element_Type) return Vector; function "&" (Left, Right : Element_Type) return Vector;
function "=" (Left, Right : Vector) return Boolean;
function Capacity (Container : Vector) return Count_Type; function Capacity (Container : Vector) return Count_Type;
procedure Reserve_Capacity procedure Reserve_Capacity
...@@ -86,6 +83,10 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -86,6 +83,10 @@ package Ada.Containers.Indefinite_Vectors is
function Length (Container : Vector) return Count_Type; function Length (Container : Vector) return Count_Type;
procedure Set_Length
(Container : in out Vector;
Length : Count_Type);
function Is_Empty (Container : Vector) return Boolean; function Is_Empty (Container : Vector) return Boolean;
procedure Clear (Container : in out Vector); procedure Clear (Container : in out Vector);
...@@ -102,6 +103,16 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -102,6 +103,16 @@ package Ada.Containers.Indefinite_Vectors is
function Element (Position : Cursor) return Element_Type; 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 procedure Query_Element
(Container : Vector; (Container : Vector;
Index : Index_Type; Index : Index_Type;
...@@ -112,24 +123,14 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -112,24 +123,14 @@ package Ada.Containers.Indefinite_Vectors is
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Update_Element procedure Update_Element
(Container : Vector; (Container : in out Vector;
Index : Index_Type; Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type)); Process : not null access procedure (Element : in out Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Vector;
Process : not null access procedure (Element : in out Element_Type)); 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);
procedure Move (Target : in out Vector; Source : in out Vector); procedure Move (Target : in out Vector; Source : in out Vector);
...@@ -197,10 +198,6 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -197,10 +198,6 @@ package Ada.Containers.Indefinite_Vectors is
Position : out Cursor; Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Set_Length
(Container : in out Vector;
Length : Count_Type);
procedure Delete procedure Delete
(Container : in out Vector; (Container : in out Vector;
Index : Extended_Index; Index : Extended_Index;
...@@ -219,6 +216,12 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -219,6 +216,12 @@ package Ada.Containers.Indefinite_Vectors is
(Container : in out Vector; (Container : in out Vector;
Count : Count_Type := 1); 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_Index (Container : Vector) return Index_Type;
function First (Container : Vector) return Cursor; function First (Container : Vector) return Cursor;
...@@ -231,21 +234,13 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -231,21 +234,13 @@ package Ada.Containers.Indefinite_Vectors is
function Last_Element (Container : Vector) return Element_Type; 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);
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 Next (Position : in out Cursor);
procedure Merge (Target, Source : in out Vector); function Previous (Position : Cursor) return Cursor;
end Generic_Sorting; procedure Previous (Position : in out Cursor);
function Find_Index function Find_Index
(Container : Vector; (Container : Vector;
...@@ -255,30 +250,22 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -255,30 +250,22 @@ package Ada.Containers.Indefinite_Vectors is
function Find function Find
(Container : Vector; (Container : Vector;
Item : Element_Type; Item : Element_Type;
Position : Cursor := No_Element) return Cursor; Position : Cursor := No_Element) return Cursor;
function Reverse_Find_Index function Reverse_Find_Index
(Container : Vector; (Container : Vector;
Item : Element_Type; Item : Element_Type;
Index : Index_Type := Index_Type'Last) return Extended_Index; Index : Index_Type := Index_Type'Last) return Extended_Index;
function Reverse_Find (Container : Vector; function Reverse_Find
Item : Element_Type; (Container : Vector;
Position : Cursor := No_Element) Item : Element_Type;
return Cursor; Position : Cursor := No_Element) return Cursor;
function Contains function Contains
(Container : Vector; (Container : Vector;
Item : Element_Type) return Boolean; 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; function Has_Element (Position : Cursor) return Boolean;
procedure Iterate procedure Iterate
...@@ -289,6 +276,18 @@ package Ada.Containers.Indefinite_Vectors is ...@@ -289,6 +276,18 @@ package Ada.Containers.Indefinite_Vectors is
(Container : Vector; (Container : Vector;
Process : not null access procedure (Position : Cursor)); 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 private
pragma Inline (First_Index); pragma Inline (First_Index);
...@@ -346,6 +345,18 @@ private ...@@ -346,6 +345,18 @@ private
Index : Index_Type := Index_Type'First; Index : Index_Type := Index_Type'First;
end record; 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); No_Element : constant Cursor := Cursor'(null, Index_Type'First);
end Ada.Containers.Indefinite_Vectors; end Ada.Containers.Indefinite_Vectors;
...@@ -303,37 +303,6 @@ package body Ada.Containers.Vectors is ...@@ -303,37 +303,6 @@ package body Ada.Containers.Vectors is
Count); Count);
end Append; 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 -- -- Capacity --
-------------- --------------
...@@ -443,8 +412,7 @@ package body Ada.Containers.Vectors is ...@@ -443,8 +412,7 @@ package body Ada.Containers.Vectors is
raise Constraint_Error; raise Constraint_Error;
end if; end if;
if Position.Container /= if Position.Container /= Container'Unrestricted_Access
Vector_Access'(Container'Unchecked_Access)
or else Position.Index > Container.Last or else Position.Index > Container.Last
then then
raise Program_Error; raise Program_Error;
...@@ -452,11 +420,17 @@ package body Ada.Containers.Vectors is ...@@ -452,11 +420,17 @@ package body Ada.Containers.Vectors is
Delete (Container, Position.Index, Count); Delete (Container, Position.Index, Count);
if Position.Index <= Container.Last then -- This is the old behavior, prior to the York API (2005/06):
Position := (Container'Unchecked_Access, Position.Index);
else -- if Position.Index <= Container.Last then
Position := No_Element; -- Position := (Container'Unchecked_Access, Position.Index);
end if; -- else
-- Position := No_Element;
-- end if;
-- This is the behavior specified by the York API:
Position := No_Element;
end Delete; end Delete;
------------------ ------------------
...@@ -539,6 +513,7 @@ package body Ada.Containers.Vectors is ...@@ -539,6 +513,7 @@ package body Ada.Containers.Vectors is
procedure Finalize (Container : in out Vector) is procedure Finalize (Container : in out Vector) is
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error; raise Program_Error;
...@@ -556,13 +531,12 @@ package body Ada.Containers.Vectors is ...@@ -556,13 +531,12 @@ package body Ada.Containers.Vectors is
function Find function Find
(Container : Vector; (Container : Vector;
Item : Element_Type; Item : Element_Type;
Position : Cursor := No_Element) return Cursor is Position : Cursor := No_Element) return Cursor
is
begin begin
if Position.Container /= null if Position.Container /= null
and then (Position.Container /= and then (Position.Container /= Container'Unrestricted_Access
Vector_Access'(Container'Unchecked_Access) or else Position.Index > Container.Last)
or else Position.Index > Container.Last)
then then
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -583,7 +557,8 @@ package body Ada.Containers.Vectors is ...@@ -583,7 +557,8 @@ package body Ada.Containers.Vectors is
function Find_Index function Find_Index
(Container : Vector; (Container : Vector;
Item : Element_Type; Item : Element_Type;
Index : Index_Type := Index_Type'First) return Extended_Index is Index : Index_Type := Index_Type'First) return Extended_Index
is
begin begin
for Indx in Index .. Container.Last loop for Indx in Index .. Container.Last loop
if Container.Elements (Indx) = Item then if Container.Elements (Indx) = Item then
...@@ -1152,6 +1127,31 @@ package body Ada.Containers.Vectors is ...@@ -1152,6 +1127,31 @@ package body Ada.Containers.Vectors is
Position := Cursor'(Container'Unchecked_Access, Index); Position := Cursor'(Container'Unchecked_Access, Index);
end Insert; 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 -- -- Insert_Space --
------------------ ------------------
...@@ -1339,7 +1339,7 @@ package body Ada.Containers.Vectors is ...@@ -1339,7 +1339,7 @@ package body Ada.Containers.Vectors is
Index := Before.Index; Index := Before.Index;
end if; end if;
Insert_Space (Container, Index, Count); Insert_Space (Container, Index, Count => Count);
Position := Cursor'(Container'Unchecked_Access, Index); Position := Cursor'(Container'Unchecked_Access, Index);
end Insert_Space; end Insert_Space;
...@@ -1365,7 +1365,6 @@ package body Ada.Containers.Vectors is ...@@ -1365,7 +1365,6 @@ package body Ada.Containers.Vectors is
B : Natural renames V.Busy; B : Natural renames V.Busy;
begin begin
B := B + 1; B := B + 1;
begin begin
...@@ -1379,7 +1378,6 @@ package body Ada.Containers.Vectors is ...@@ -1379,7 +1378,6 @@ package body Ada.Containers.Vectors is
end; end;
B := B - 1; B := B - 1;
end Iterate; end Iterate;
---------- ----------
...@@ -1620,14 +1618,22 @@ package body Ada.Containers.Vectors is ...@@ -1620,14 +1618,22 @@ package body Ada.Containers.Vectors is
end loop; end loop;
end Read; end Read;
procedure Read
(Stream : access Root_Stream_Type'Class;
Position : out Cursor)
is
begin
raise Program_Error;
end Read;
--------------------- ---------------------
-- Replace_Element -- -- Replace_Element --
--------------------- ---------------------
procedure Replace_Element procedure Replace_Element
(Container : Vector; (Container : in out Vector;
Index : Index_Type; Index : Index_Type;
By : Element_Type) New_Item : Element_Type)
is is
begin begin
if Index > Container.Last then if Index > Container.Last then
...@@ -1638,16 +1644,24 @@ package body Ada.Containers.Vectors is ...@@ -1638,16 +1644,24 @@ package body Ada.Containers.Vectors is
raise Program_Error; raise Program_Error;
end if; end if;
Container.Elements (Index) := By; Container.Elements (Index) := New_Item;
end Replace_Element; 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 begin
if Position.Container = null then if Position.Container = null then
raise Constraint_Error; raise Constraint_Error;
end if; 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; end Replace_Element;
---------------------- ----------------------
...@@ -1799,6 +1813,41 @@ package body Ada.Containers.Vectors is ...@@ -1799,6 +1813,41 @@ package body Ada.Containers.Vectors is
end; end;
end Reserve_Capacity; 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 -- -- Reverse_Find --
------------------ ------------------
...@@ -1921,7 +1970,7 @@ package body Ada.Containers.Vectors is ...@@ -1921,7 +1970,7 @@ package body Ada.Containers.Vectors is
-- Swap -- -- Swap --
---------- ----------
procedure Swap (Container : Vector; I, J : Index_Type) is procedure Swap (Container : in out Vector; I, J : Index_Type) is
begin begin
if I > Container.Last if I > Container.Last
or else J > Container.Last or else J > Container.Last
...@@ -1949,7 +1998,7 @@ package body Ada.Containers.Vectors is ...@@ -1949,7 +1998,7 @@ package body Ada.Containers.Vectors is
end; end;
end Swap; end Swap;
procedure Swap (I, J : Cursor) is procedure Swap (Container : in out Vector; I, J : Cursor) is
begin begin
if I.Container = null if I.Container = null
or else J.Container = null or else J.Container = null
...@@ -1957,11 +2006,13 @@ package body Ada.Containers.Vectors is ...@@ -1957,11 +2006,13 @@ package body Ada.Containers.Vectors is
raise Constraint_Error; raise Constraint_Error;
end if; 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; raise Program_Error;
end if; end if;
Swap (I.Container.all, I.Index, J.Index); Swap (Container, I.Index, J.Index);
end Swap; end Swap;
--------------- ---------------
...@@ -2057,13 +2108,12 @@ package body Ada.Containers.Vectors is ...@@ -2057,13 +2108,12 @@ package body Ada.Containers.Vectors is
-------------------- --------------------
procedure Update_Element procedure Update_Element
(Container : Vector; (Container : in out Vector;
Index : Index_Type; Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type)) Process : not null access procedure (Element : in out Element_Type))
is is
V : Vector renames Container'Unrestricted_Access.all; B : Natural renames Container.Busy;
B : Natural renames V.Busy; L : Natural renames Container.Lock;
L : Natural renames V.Lock;
begin begin
if Index > Container.Last then if Index > Container.Last then
...@@ -2074,7 +2124,7 @@ package body Ada.Containers.Vectors is ...@@ -2074,7 +2124,7 @@ package body Ada.Containers.Vectors is
L := L + 1; L := L + 1;
begin begin
Process (V.Elements (Index)); Process (Container.Elements (Index));
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -2087,15 +2137,20 @@ package body Ada.Containers.Vectors is ...@@ -2087,15 +2137,20 @@ package body Ada.Containers.Vectors is
end Update_Element; end Update_Element;
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Vector;
Process : not null access procedure (Element : in out Element_Type)) Position : Cursor;
Process : not null access procedure (Element : in out Element_Type))
is is
begin begin
if Position.Container = null then if Position.Container = null then
raise Constraint_Error; raise Constraint_Error;
end if; 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; end Update_Element;
----------- -----------
...@@ -2114,4 +2169,12 @@ package body Ada.Containers.Vectors is ...@@ -2114,4 +2169,12 @@ package body Ada.Containers.Vectors is
end loop; end loop;
end Write; end Write;
procedure Write
(Stream : access Root_Stream_Type'Class;
Position : Cursor)
is
begin
raise Program_Error;
end Write;
end Ada.Containers.Vectors; end Ada.Containers.Vectors;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -50,8 +50,6 @@ package Ada.Containers.Vectors is ...@@ -50,8 +50,6 @@ package Ada.Containers.Vectors is
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
subtype Index_Subtype is Index_Type;
type Vector is tagged private; type Vector is tagged private;
type Cursor is private; type Cursor is private;
...@@ -60,6 +58,8 @@ package Ada.Containers.Vectors is ...@@ -60,6 +58,8 @@ package Ada.Containers.Vectors is
No_Element : constant Cursor; No_Element : constant Cursor;
function "=" (Left, Right : Vector) return Boolean;
function To_Vector (Length : Count_Type) return Vector; function To_Vector (Length : Count_Type) return Vector;
function To_Vector function To_Vector
...@@ -74,8 +74,6 @@ package Ada.Containers.Vectors is ...@@ -74,8 +74,6 @@ package Ada.Containers.Vectors is
function "&" (Left, Right : Element_Type) return Vector; function "&" (Left, Right : Element_Type) return Vector;
function "=" (Left, Right : Vector) return Boolean;
function Capacity (Container : Vector) return Count_Type; function Capacity (Container : Vector) return Count_Type;
procedure Reserve_Capacity procedure Reserve_Capacity
...@@ -84,6 +82,10 @@ package Ada.Containers.Vectors is ...@@ -84,6 +82,10 @@ package Ada.Containers.Vectors is
function Length (Container : Vector) return Count_Type; function Length (Container : Vector) return Count_Type;
procedure Set_Length
(Container : in out Vector;
Length : Count_Type);
function Is_Empty (Container : Vector) return Boolean; function Is_Empty (Container : Vector) return Boolean;
procedure Clear (Container : in out Vector); procedure Clear (Container : in out Vector);
...@@ -100,6 +102,16 @@ package Ada.Containers.Vectors is ...@@ -100,6 +102,16 @@ package Ada.Containers.Vectors is
function Element (Position : Cursor) return Element_Type; 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 procedure Query_Element
(Container : Vector; (Container : Vector;
Index : Index_Type; Index : Index_Type;
...@@ -110,22 +122,14 @@ package Ada.Containers.Vectors is ...@@ -110,22 +122,14 @@ package Ada.Containers.Vectors is
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Update_Element procedure Update_Element
(Container : Vector; (Container : in out Vector;
Index : Index_Type; Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type)); Process : not null access procedure (Element : in out Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Vector;
Process : not null access procedure (Element : in out Element_Type)); 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);
procedure Move (Target : in out Vector; Source : in out Vector); procedure Move (Target : in out Vector; Source : in out Vector);
...@@ -164,6 +168,17 @@ package Ada.Containers.Vectors is ...@@ -164,6 +168,17 @@ package Ada.Containers.Vectors is
Position : out Cursor; Position : out Cursor;
Count : Count_Type := 1); 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 procedure Prepend
(Container : in out Vector; (Container : in out Vector;
New_Item : Vector); New_Item : Vector);
...@@ -193,10 +208,6 @@ package Ada.Containers.Vectors is ...@@ -193,10 +208,6 @@ package Ada.Containers.Vectors is
Position : out Cursor; Position : out Cursor;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Set_Length
(Container : in out Vector;
Length : Count_Type);
procedure Delete procedure Delete
(Container : in out Vector; (Container : in out Vector;
Index : Extended_Index; Index : Extended_Index;
...@@ -215,6 +226,12 @@ package Ada.Containers.Vectors is ...@@ -215,6 +226,12 @@ package Ada.Containers.Vectors is
(Container : in out Vector; (Container : in out Vector;
Count : Count_Type := 1); 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_Index (Container : Vector) return Index_Type;
function First (Container : Vector) return Cursor; function First (Container : Vector) return Cursor;
...@@ -227,21 +244,13 @@ package Ada.Containers.Vectors is ...@@ -227,21 +244,13 @@ package Ada.Containers.Vectors is
function Last_Element (Container : Vector) return Element_Type; 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);
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 Next (Position : in out Cursor);
procedure Merge (Target, Source : in out Vector); function Previous (Position : Cursor) return Cursor;
end Generic_Sorting; procedure Previous (Position : in out Cursor);
function Find_Index function Find_Index
(Container : Vector; (Container : Vector;
...@@ -267,14 +276,6 @@ package Ada.Containers.Vectors is ...@@ -267,14 +276,6 @@ package Ada.Containers.Vectors is
(Container : Vector; (Container : Vector;
Item : Element_Type) return Boolean; 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; function Has_Element (Position : Cursor) return Boolean;
procedure Iterate procedure Iterate
...@@ -285,6 +286,18 @@ package Ada.Containers.Vectors is ...@@ -285,6 +286,18 @@ package Ada.Containers.Vectors is
(Container : Vector; (Container : Vector;
Process : not null access procedure (Position : Cursor)); 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 private
pragma Inline (First_Index); pragma Inline (First_Index);
...@@ -340,6 +353,18 @@ private ...@@ -340,6 +353,18 @@ private
Index : Index_Type := Index_Type'First; Index : Index_Type := Index_Type'First;
end record; 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); No_Element : constant Cursor := Cursor'(null, Index_Type'First);
end Ada.Containers.Vectors; end Ada.Containers.Vectors;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -38,9 +38,7 @@ with Ada.Finalization; ...@@ -38,9 +38,7 @@ with Ada.Finalization;
with Ada.Streams; with Ada.Streams;
generic generic
type Key_Type is private; type Key_Type is private;
type Element_Type is private; type Element_Type is private;
with function "<" (Left, Right : Key_Type) return Boolean is <>; with function "<" (Left, Right : Key_Type) return Boolean is <>;
...@@ -49,6 +47,8 @@ generic ...@@ -49,6 +47,8 @@ generic
package Ada.Containers.Ordered_Maps is package Ada.Containers.Ordered_Maps is
pragma Preelaborate; pragma Preelaborate;
function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
type Map is tagged private; type Map is tagged private;
type Cursor is private; type Cursor is private;
...@@ -69,18 +69,22 @@ package Ada.Containers.Ordered_Maps is ...@@ -69,18 +69,22 @@ package Ada.Containers.Ordered_Maps is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Map;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access Process : not null access
procedure (Key : Key_Type; Element : Element_Type)); procedure (Key : Key_Type; Element : Element_Type));
procedure Update_Element procedure Update_Element
(Position : Cursor; (Container : in out Map;
Process : not null access Position : Cursor;
Process : not null access
procedure (Key : Key_Type; Element : in out Element_Type)); 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 Move (Target : in out Map; Source : in out Map);
procedure Insert procedure Insert
...@@ -111,6 +115,8 @@ package Ada.Containers.Ordered_Maps is ...@@ -111,6 +115,8 @@ package Ada.Containers.Ordered_Maps is
Key : Key_Type; Key : Key_Type;
New_Item : Element_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; Key : Key_Type);
procedure Delete (Container : in out Map; Position : in out Cursor); procedure Delete (Container : in out Map; Position : in out Cursor);
...@@ -119,30 +125,18 @@ package Ada.Containers.Ordered_Maps is ...@@ -119,30 +125,18 @@ package Ada.Containers.Ordered_Maps is
procedure Delete_Last (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 (Container : Map) return Cursor;
function First_Key (Container : Map) return Key_Type;
function First_Element (Container : Map) return Element_Type; function First_Element (Container : Map) return Element_Type;
function Last (Container : Map) return Cursor; function First_Key (Container : Map) return Key_Type;
function Last_Key (Container : Map) return Key_Type; function Last (Container : Map) return Cursor;
function Last_Element (Container : Map) return Element_Type; function Last_Element (Container : Map) return Element_Type;
function Last_Key (Container : Map) return Key_Type;
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
...@@ -151,6 +145,16 @@ package Ada.Containers.Ordered_Maps is ...@@ -151,6 +145,16 @@ package Ada.Containers.Ordered_Maps is
procedure Previous (Position : in out Cursor); 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 Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -202,8 +206,9 @@ private ...@@ -202,8 +206,9 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; 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; for Map_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -211,9 +216,19 @@ private ...@@ -211,9 +216,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -46,6 +46,8 @@ generic ...@@ -46,6 +46,8 @@ generic
package Ada.Containers.Ordered_Multisets is package Ada.Containers.Ordered_Multisets is
pragma Preelaborate; pragma Preelaborate;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
type Set is tagged private; type Set is tagged private;
type Cursor is private; type Cursor is private;
...@@ -58,6 +60,8 @@ package Ada.Containers.Ordered_Multisets is ...@@ -58,6 +60,8 @@ package Ada.Containers.Ordered_Multisets is
function Equivalent_Sets (Left, Right : Set) return Boolean; 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 Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean; function Is_Empty (Container : Set) return Boolean;
...@@ -66,18 +70,16 @@ package Ada.Containers.Ordered_Multisets is ...@@ -66,18 +70,16 @@ package Ada.Containers.Ordered_Multisets is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Replace_Element procedure Move (Target : in out Set; Source : in out Set);
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move
(Target : in out Set;
Source : in out Set);
procedure Insert procedure Insert
(Container : in out Set; (Container : in out Set;
...@@ -88,6 +90,16 @@ package Ada.Containers.Ordered_Multisets is ...@@ -88,6 +90,16 @@ package Ada.Containers.Ordered_Multisets is
(Container : in out Set; (Container : in out Set;
New_Item : Element_Type); 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 procedure Delete
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
...@@ -100,10 +112,6 @@ package Ada.Containers.Ordered_Multisets is ...@@ -100,10 +112,6 @@ package Ada.Containers.Ordered_Multisets is
procedure Delete_Last (Container : in out Set); 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; function Union (Left, Right : Set) return Set;
...@@ -132,14 +140,6 @@ package Ada.Containers.Ordered_Multisets is ...@@ -132,14 +140,6 @@ package Ada.Containers.Ordered_Multisets is
function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; 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 (Container : Set) return Cursor;
function First_Element (Container : Set) return Element_Type; function First_Element (Container : Set) return Element_Type;
...@@ -156,6 +156,14 @@ package Ada.Containers.Ordered_Multisets is ...@@ -156,6 +156,14 @@ package Ada.Containers.Ordered_Multisets is
procedure Previous (Position : in out Cursor); 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 Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -189,47 +197,37 @@ package Ada.Containers.Ordered_Multisets is ...@@ -189,47 +197,37 @@ package Ada.Containers.Ordered_Multisets is
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function "<" (Left : Key_Type; Right : Element_Type) with function "<" (Left, Right : Key_Type) return Boolean is <>;
return Boolean is <>;
with function ">" (Left : Key_Type; Right : Element_Type)
return Boolean is <>;
package Generic_Keys is package Generic_Keys is
function Contains (Container : Set; Key : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
function Find (Container : Set; Key : Key_Type) return Cursor;
function Floor (Container : Set; Key : Key_Type) return Cursor;
function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_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); procedure Exclude (Container : in out Set; Key : Key_Type);
function "<" (Left : Cursor; Right : Key_Type) return Boolean; procedure Delete (Container : in out Set; Key : Key_Type);
function Find (Container : Set; Key : Key_Type) return Cursor;
function ">" (Left : Cursor; Right : Key_Type) return Boolean; function Floor (Container : Set; Key : Key_Type) return Cursor;
function "<" (Left : Key_Type; Right : Cursor) return Boolean; function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
procedure (Element : in out Element_Type)); procedure (Element : in out Element_Type));
procedure Iterate procedure Iterate
(Container : Set; (Container : Set;
...@@ -271,6 +269,7 @@ private ...@@ -271,6 +269,7 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -280,9 +279,19 @@ private ...@@ -280,9 +279,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -60,6 +60,8 @@ package Ada.Containers.Ordered_Sets is ...@@ -60,6 +60,8 @@ package Ada.Containers.Ordered_Sets is
function Equivalent_Sets (Left, Right : Set) return Boolean; 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 Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean; function Is_Empty (Container : Set) return Boolean;
...@@ -255,6 +257,7 @@ private ...@@ -255,6 +257,7 @@ private
use Red_Black_Trees; use Red_Black_Trees;
use Tree_Types; use Tree_Types;
use Ada.Finalization; use Ada.Finalization;
use Ada.Streams;
type Set_Access is access all Set; type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
...@@ -264,9 +267,19 @@ private ...@@ -264,9 +267,19 @@ private
Node : Node_Access; Node : Node_Access;
end record; 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 procedure Write
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow -- -- GNAT. The copyright notice above, and the license provisions that follow --
...@@ -56,7 +56,14 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is ...@@ -56,7 +56,14 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is
function Max (Node : Node_Access) return Node_Access; 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; function Next (Node : Node_Access) return Node_Access;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment