Commit 8704d4b3 by Matthew Heaney Committed by Arnaud Charlet

a-swunha.ads, [...]: Removed.

2005-06-14  Matthew Heaney  <heaney@adacore.com>

	* a-swunha.ads, a-swunha.adb: Removed. Replaced by a-swuwha.ad[sb]
	* a-swuwha.ads, a-swuwha.adb: New files

	* a-szunha.ads, a-szunha.adb: Removed, replaced by a-szuzha.ad[sb]
	* a-szuzha.ads, a-szuzha.adb: New files.

	* a-rbtgso.adb, a-crbtgo.ads, a-crbtgo.adb, a-crbtgk.ads,
	a-crbtgk.adb, a-crbltr.ads, a-coorse.ads, a-coorse.adb, a-convec.ads,
	a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohata.ads, 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-chtgop.ads, a-chtgop.adb, a-cdlili.ads,
	a-cdlili.adb, a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb,
	a-cohase.ads, a-ciorma.ads, a-coorma.ads, a-ciormu.ads, a-coormu.ads,
	a-swunha.adb, a-stunha.adb, a-ciorma.adb, a-coorma.adb, a-shcain.ads,
	a-shcain.adb, a-chtgke.ads, a-chtgke.adb, a-stwiha.ads, a-stwiha.adb,
	a-strhas.adb, a-stzhas.adb: synchronized to the latest version of the
	Ada 2005 RM.

From-SVN: r101069
parent dc8f5791
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.DOUBLY_LINKED_LISTS -- -- A D A . C O N T A I N E R S . D O U B L Y _ L I N K E D _ L I S T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -122,18 +122,20 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -122,18 +122,20 @@ package Ada.Containers.Doubly_Linked_Lists is
Count : Count_Type := 1); Count : Count_Type := 1);
generic generic
with function "<" (Left, Right : Element_Type) with function "<" (Left, Right : Element_Type) return Boolean is <>;
return Boolean is <>; package Generic_Sorting is
procedure Generic_Sort (Container : in out List);
generic function Is_Sorted (Container : List) return Boolean;
with function "<" (Left, Right : Element_Type)
return Boolean is <>; procedure Sort (Container : in out List);
procedure Generic_Merge (Target : in out List; Source : in out List);
procedure Merge (Target, Source : in out List);
end Generic_Sorting;
procedure Reverse_List (Container : in out List); procedure Reverse_List (Container : in out List);
procedure Swap (I, J : in Cursor); procedure Swap (I, J : Cursor);
procedure Swap_Links procedure Swap_Links
(Container : in out List; (Container : in out List;
...@@ -153,7 +155,7 @@ package Ada.Containers.Doubly_Linked_Lists is ...@@ -153,7 +155,7 @@ package Ada.Containers.Doubly_Linked_Lists is
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Source : in out List; Source : in out List;
Position : Cursor); Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
...@@ -200,14 +202,12 @@ private ...@@ -200,14 +202,12 @@ private
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
type Node_Type is type Node_Type is
record limited record
Element : Element_Type; Element : Element_Type;
Next : Node_Access; Next : Node_Access;
Prev : Node_Access; Prev : Node_Access;
end record; end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
use Ada.Finalization; use Ada.Finalization;
type List is type List is
...@@ -215,6 +215,8 @@ private ...@@ -215,6 +215,8 @@ private
First : Node_Access; First : Node_Access;
Last : Node_Access; Last : Node_Access;
Length : Count_Type := 0; Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
procedure Adjust (Container : in out List); procedure Adjust (Container : in out List);
...@@ -235,7 +237,7 @@ private ...@@ -235,7 +237,7 @@ private
for List'Write use Write; for List'Write use Write;
Empty_List : constant List := List'(Controlled with null, null, 0); Empty_List : constant List := (Controlled with null, null, 0, 0, 0);
type List_Access is access constant List; type List_Access is access constant List;
for List_Access'Storage_Size use 0; for List_Access'Storage_Size use 0;
...@@ -249,4 +251,3 @@ private ...@@ -249,4 +251,3 @@ private
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;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASH_TABLES.GENERIC_KEYS -- -- A D A . C O N T A I N E R S . --
-- H A S H _ T A B L E S . G E N E R I C _ K E Y S --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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,7 +41,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -40,7 +41,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
-------------------------- --------------------------
procedure Delete_Key_Sans_Free procedure Delete_Key_Sans_Free
(HT : in out HT_Type; (HT : in out Hash_Table_Type;
Key : Key_Type; Key : Key_Type;
X : out Node_Access) X : out Node_Access)
is is
...@@ -49,18 +50,21 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -49,18 +50,21 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
begin begin
if HT.Length = 0 then if HT.Length = 0 then
X := Null_Node; X := null;
return; return;
end if; end if;
Indx := Index (HT, Key); Indx := Index (HT, Key);
X := HT.Buckets (Indx); X := HT.Buckets (Indx);
if X = Null_Node then if X = null then
return; return;
end if; end if;
if Equivalent_Keys (Key, X) then if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
raise Program_Error;
end if;
HT.Buckets (Indx) := Next (X); HT.Buckets (Indx) := Next (X);
HT.Length := HT.Length - 1; HT.Length := HT.Length - 1;
return; return;
...@@ -70,11 +74,14 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -70,11 +74,14 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
Prev := X; Prev := X;
X := Next (Prev); X := Next (Prev);
if X = Null_Node then if X = null then
return; return;
end if; end if;
if Equivalent_Keys (Key, X) then if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
raise Program_Error;
end if;
Set_Next (Node => Prev, Next => Next (X)); Set_Next (Node => Prev, Next => Next (X));
HT.Length := HT.Length - 1; HT.Length := HT.Length - 1;
return; return;
...@@ -87,7 +94,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -87,7 +94,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
---------- ----------
function Find function Find
(HT : HT_Type; (HT : Hash_Table_Type;
Key : Key_Type) return Node_Access is Key : Key_Type) return Node_Access is
Indx : Hash_Type; Indx : Hash_Type;
...@@ -95,20 +102,20 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -95,20 +102,20 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
begin begin
if HT.Length = 0 then if HT.Length = 0 then
return Null_Node; return null;
end if; end if;
Indx := Index (HT, Key); Indx := Index (HT, Key);
Node := HT.Buckets (Indx); Node := HT.Buckets (Indx);
while Node /= Null_Node loop while Node /= null loop
if Equivalent_Keys (Key, Node) then if Equivalent_Keys (Key, Node) then
return Node; return Node;
end if; end if;
Node := Next (Node); Node := Next (Node);
end loop; end loop;
return Null_Node; return null;
end Find; end Find;
-------------------------------- --------------------------------
...@@ -116,10 +123,10 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -116,10 +123,10 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
-------------------------------- --------------------------------
procedure Generic_Conditional_Insert procedure Generic_Conditional_Insert
(HT : in out HT_Type; (HT : in out Hash_Table_Type;
Key : Key_Type; Key : Key_Type;
Node : out Node_Access; Node : out Node_Access;
Success : out Boolean) Inserted : out Boolean)
is is
Indx : constant Hash_Type := Index (HT, Key); Indx : constant Hash_Type := Index (HT, Key);
B : Node_Access renames HT.Buckets (Indx); B : Node_Access renames HT.Buckets (Indx);
...@@ -127,12 +134,16 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -127,12 +134,16 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1; subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
begin begin
if B = Null_Node then if B = null then
if HT.Busy > 0 then
raise Program_Error;
end if;
declare declare
Length : constant Length_Subtype := HT.Length; Length : constant Length_Subtype := HT.Length;
begin begin
Node := New_Node (Next => Null_Node); Node := New_Node (Next => null);
Success := True; Inserted := True;
B := Node; B := Node;
HT.Length := Length + 1; HT.Length := Length + 1;
...@@ -144,20 +155,24 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -144,20 +155,24 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
Node := B; Node := B;
loop loop
if Equivalent_Keys (Key, Node) then if Equivalent_Keys (Key, Node) then
Success := False; Inserted := False;
return; return;
end if; end if;
Node := Next (Node); Node := Next (Node);
exit when Node = Null_Node; exit when Node = null;
end loop; end loop;
if HT.Busy > 0 then
raise Program_Error;
end if;
declare declare
Length : constant Length_Subtype := HT.Length; Length : constant Length_Subtype := HT.Length;
begin begin
Node := New_Node (Next => B); Node := New_Node (Next => B);
Success := True; Inserted := True;
B := Node; B := Node;
HT.Length := Length + 1; HT.Length := Length + 1;
...@@ -169,7 +184,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -169,7 +184,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
----------- -----------
function Index function Index
(HT : HT_Type; (HT : Hash_Table_Type;
Key : Key_Type) return Hash_Type is Key : Key_Type) return Hash_Type is
begin begin
return Hash (Key) mod HT.Buckets'Length; return Hash (Key) mod HT.Buckets'Length;
......
...@@ -2,27 +2,44 @@ ...@@ -2,27 +2,44 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASH_TABLES.GENERIC_KEYS -- -- A D A . C O N T A I N E R S . --
-- H A S H _ T A B L E S . G E N E R I C _ K E Y S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
generic generic
with package HT_Types is with package HT_Types is
new Generic_Hash_Table_Types (<>); new Generic_Hash_Table_Types (<>);
type HT_Type is new HT_Types.Hash_Table_Type with private;
use HT_Types; use HT_Types;
Null_Node : Node_Access;
with function Next (Node : Node_Access) return Node_Access; with function Next (Node : Node_Access) return Node_Access;
with procedure Set_Next with procedure Set_Next
...@@ -41,24 +58,24 @@ package Ada.Containers.Hash_Tables.Generic_Keys is ...@@ -41,24 +58,24 @@ package Ada.Containers.Hash_Tables.Generic_Keys is
pragma Preelaborate; pragma Preelaborate;
function Index function Index
(HT : HT_Type; (HT : Hash_Table_Type;
Key : Key_Type) return Hash_Type; Key : Key_Type) return Hash_Type;
pragma Inline (Index); pragma Inline (Index);
procedure Delete_Key_Sans_Free procedure Delete_Key_Sans_Free
(HT : in out HT_Type; (HT : in out Hash_Table_Type;
Key : Key_Type; Key : Key_Type;
X : out Node_Access); X : out Node_Access);
function Find (HT : HT_Type; Key : Key_Type) return Node_Access; function Find (HT : Hash_Table_Type; Key : Key_Type) return Node_Access;
generic generic
with function New_Node with function New_Node
(Next : Node_Access) return Node_Access; (Next : Node_Access) return Node_Access;
procedure Generic_Conditional_Insert procedure Generic_Conditional_Insert
(HT : in out HT_Type; (HT : in out Hash_Table_Type;
Key : Key_Type; Key : Key_Type;
Node : out Node_Access; Node : out Node_Access;
Success : out Boolean); Inserted : out Boolean);
end Ada.Containers.Hash_Tables.Generic_Keys; end Ada.Containers.Hash_Tables.Generic_Keys;
...@@ -2,12 +2,11 @@ ...@@ -2,12 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASH_TABLES.GENERIC_OPERATIONS -- -- A D A . C O N T A I N E R S . --
-- H A S H _ T A B L E S . G E N E R I C _ O P E R A T I O N S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
...@@ -22,12 +21,8 @@ generic ...@@ -22,12 +21,8 @@ generic
with package HT_Types is with package HT_Types is
new Generic_Hash_Table_Types (<>); new Generic_Hash_Table_Types (<>);
type Hash_Table_Type is new HT_Types.Hash_Table_Type with private;
use HT_Types; use HT_Types;
Null_Node : in Node_Access;
with function Hash_Node (Node : Node_Access) return Hash_Type; with function Hash_Node (Node : Node_Access) return Hash_Type;
with function Next (Node : Node_Access) return Node_Access; with function Next (Node : Node_Access) return Node_Access;
...@@ -72,7 +67,7 @@ package Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -72,7 +67,7 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
function Capacity (HT : Hash_Table_Type) return Count_Type; function Capacity (HT : Hash_Table_Type) return Count_Type;
procedure Ensure_Capacity procedure Reserve_Capacity
(HT : in out Hash_Table_Type; (HT : in out Hash_Table_Type;
N : Count_Type); N : Count_Type);
...@@ -108,4 +103,3 @@ package Ada.Containers.Hash_Tables.Generic_Operations is ...@@ -108,4 +103,3 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
HT : out Hash_Table_Type); HT : out Hash_Table_Type);
end Ada.Containers.Hash_Tables.Generic_Operations; end Ada.Containers.Hash_Tables.Generic_Operations;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_DOUBLY_LINKED_LISTS -- -- A D A . C O N T A I N E R S . --
-- I N D E F I N I T E _ D O U B L Y _ L I N K E D _ L I S T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -118,16 +119,16 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -118,16 +119,16 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Count : Count_Type := 1); Count : Count_Type := 1);
generic generic
with function "<" (Left, Right : Element_Type) with function "<" (Left, Right : Element_Type) return Boolean is <>;
return Boolean is <>; package Generic_Sorting is
procedure Generic_Sort (Container : in out List);
generic function Is_Sorted (Container : List) return Boolean;
with function "<" (Left, Right : Element_Type)
return Boolean is <>; procedure Sort (Container : in out List);
procedure Generic_Merge
(Target : in out List; procedure Merge (Target, Source : in out List);
Source : in out List);
end Generic_Sorting;
procedure Reverse_List (Container : in out List); procedure Reverse_List (Container : in out List);
...@@ -149,7 +150,7 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -149,7 +150,7 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
(Target : in out List; (Target : in out List;
Before : Cursor; Before : Cursor;
Source : in out List; Source : in out List;
Position : Cursor); Position : in out Cursor);
function First (Container : List) return Cursor; function First (Container : List) return Cursor;
...@@ -198,14 +199,12 @@ private ...@@ -198,14 +199,12 @@ private
type Element_Access is access Element_Type; type Element_Access is access Element_Type;
type Node_Type is type Node_Type is
record limited record
Element : Element_Access; Element : Element_Access;
Next : Node_Access; Next : Node_Access;
Prev : Node_Access; Prev : Node_Access;
end record; end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
use Ada.Finalization; use Ada.Finalization;
type List is type List is
...@@ -213,6 +212,8 @@ private ...@@ -213,6 +212,8 @@ private
First : Node_Access; First : Node_Access;
Last : Node_Access; Last : Node_Access;
Length : Count_Type := 0; Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
procedure Adjust (Container : in out List); procedure Adjust (Container : in out List);
...@@ -233,7 +234,7 @@ private ...@@ -233,7 +234,7 @@ private
for List'Write use Write; for List'Write use Write;
Empty_List : constant List := List'(Controlled with null, null, 0); Empty_List : constant List := List'(Controlled with null, null, 0, 0, 0);
type List_Access is access constant List; type List_Access is access constant List;
for List_Access'Storage_Size use 0; for List_Access'Storage_Size use 0;
...@@ -247,5 +248,3 @@ private ...@@ -247,5 +248,3 @@ private
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;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_HASHED_MAPS -- -- A D A . C O N T A I N E R S . --
-- I N D E F I N I T E _ H A S H E D _ M A P S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -35,6 +36,7 @@ ...@@ -35,6 +36,7 @@
with Ada.Containers.Hash_Tables; with Ada.Containers.Hash_Tables;
with Ada.Streams; with Ada.Streams;
with Ada.Finalization;
generic generic
type Key_Type (<>) is private; type Key_Type (<>) is private;
...@@ -61,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -61,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Maps is
procedure Clear (Container : in out Map); procedure Clear (Container : in out Map);
function Key (Position : Cursor) return Key_Type;
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Query_Element procedure Query_Element
...@@ -105,14 +109,14 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -105,14 +109,14 @@ package Ada.Containers.Indefinite_Hashed_Maps is
(Container : in out Map; (Container : in out Map;
Key : Key_Type); Key : Key_Type);
procedure Exclude
(Container : in out Map;
Key : Key_Type);
procedure Delete procedure Delete
(Container : in out Map; (Container : in out Map;
Position : in out Cursor); Position : in out Cursor);
procedure Exclude
(Container : in out Map;
Key : Key_Type);
function Contains function Contains
(Container : Map; (Container : Map;
Key : Key_Type) return Boolean; Key : Key_Type) return Boolean;
...@@ -125,12 +129,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -125,12 +129,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
(Container : Map; (Container : Map;
Key : Key_Type) return Element_Type; Key : Key_Type) return Element_Type;
function Capacity (Container : Map) return Count_Type;
procedure Reserve_Capacity
(Container : in out Map;
Capacity : Count_Type);
function First (Container : Map) return Cursor; function First (Container : Map) return Cursor;
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
...@@ -139,8 +137,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -139,8 +137,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
function Key (Position : Cursor) return Key_Type;
function Equivalent_Keys (Left, Right : Cursor) function Equivalent_Keys (Left, Right : Cursor)
return Boolean; return Boolean;
...@@ -156,16 +152,48 @@ package Ada.Containers.Indefinite_Hashed_Maps is ...@@ -156,16 +152,48 @@ package Ada.Containers.Indefinite_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 (Length);
pragma Inline (Is_Empty);
pragma Inline (Clear);
pragma Inline (Key);
pragma Inline (Element);
pragma Inline (Move);
pragma Inline (Contains);
pragma Inline (Capacity);
pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package HT_Types is type Key_Access is access Key_Type;
new Hash_Tables.Generic_Hash_Table_Types (Node_Access); type Element_Access is access Element_Type;
use HT_Types; type Node_Type is limited record
Key : Key_Access;
Element : Element_Access;
Next : Node_Access;
end record;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
(Node_Type,
Node_Access);
type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
end record;
type Map is new Hash_Table_Type with null record; use HT_Types;
use Ada.Finalization;
procedure Adjust (Container : in out Map); procedure Adjust (Container : in out Map);
...@@ -198,9 +226,6 @@ private ...@@ -198,9 +226,6 @@ private
for Map'Read use Read; for Map'Read use Read;
Empty_Map : constant Map := (Hash_Table_Type with null record); Empty_Map : constant Map := (Controlled with HT => (null, 0, 0, 0));
end Ada.Containers.Indefinite_Hashed_Maps; end Ada.Containers.Indefinite_Hashed_Maps;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_ORDERED_MAPS -- -- A D A . C O N T A I N E R S . --
-- I N D E F I N I T E _ O R D E R E D _ M A P S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -110,10 +111,6 @@ pragma Preelaborate (Indefinite_Ordered_Maps); ...@@ -110,10 +111,6 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
(Container : in out Map; (Container : in out Map;
Key : Key_Type); Key : Key_Type);
procedure Exclude
(Container : in out Map;
Key : Key_Type);
procedure Delete procedure Delete
(Container : in out Map; (Container : in out Map;
Position : in out Cursor); Position : in out Cursor);
...@@ -122,6 +119,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps); ...@@ -122,6 +119,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
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 function Contains
(Container : Map; (Container : Map;
Key : Key_Type) return Boolean; Key : Key_Type) return Boolean;
...@@ -156,10 +157,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps); ...@@ -156,10 +157,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -189,21 +190,35 @@ private ...@@ -189,21 +190,35 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Key_Access is access Key_Type;
new Red_Black_Trees.Generic_Tree_Types (Node_Access); type Element_Access is access Element_Type;
use Tree_Types; type Node_Type is limited record
use Ada.Finalization; Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Access;
Element : Element_Access;
end record;
type Map is new Controlled with record package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
Tree : Tree_Type := (Length => 0, others => null); (Node_Type,
Node_Access);
type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Map); procedure Adjust (Container : in out Map);
procedure Finalize (Container : in out Map) renames Clear; procedure Finalize (Container : in out Map) renames Clear;
type Map_Access is access constant Map; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Map_Access is access Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -228,7 +243,11 @@ private ...@@ -228,7 +243,11 @@ private
for Map'Read use Read; for Map'Read use Read;
Empty_Map : constant Map := Empty_Map : constant Map :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Indefinite_Ordered_Maps; end Ada.Containers.Indefinite_Ordered_Maps;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_ORDERED_MULTISETS -- -- A D A . C O N T A I N E R S . --
-- I N D E F I N I T E _ O R D E R E D _ M U L T I S E T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -56,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
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;
...@@ -68,6 +71,11 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -68,6 +71,11 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
(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
...@@ -79,22 +87,13 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -79,22 +87,13 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
procedure Delete (Container : in out Set; Item : Element_Type); procedure Delete (Container : in out Set; Item : Element_Type);
procedure Exclude (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);
procedure Delete_First (Container : in out Set); procedure Delete_First (Container : in out Set);
procedure Delete_Last (Container : in out Set); procedure Delete_Last (Container : in out Set);
procedure Exclude (Container : in out Set; Item : Element_Type);
-- NOTE: The following operation is named Replace in the Madison API.
-- However, it should be named Replace_Element ???
--
-- procedure Replace
-- (Container : in out Set;
-- Position : Cursor;
-- By : Element_Type);
procedure Union (Target : in out Set; procedure Union (Target : in out Set;
Source : Set); Source : Set);
...@@ -143,10 +142,10 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -143,10 +142,10 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -207,12 +206,6 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -207,12 +206,6 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
-- NOTE: in post-madison api ???
-- procedure Replace
-- (Container : in out Set;
-- Key : Key_Type;
-- New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_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);
...@@ -225,7 +218,7 @@ pragma Preelaborate (Indefinite_Ordered_Multisets); ...@@ -225,7 +218,7 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function ">" (Left : Key_Type; Right : Cursor) return Boolean;
procedure Checked_Update_Element 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
...@@ -248,21 +241,33 @@ private ...@@ -248,21 +241,33 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Element_Access is access Element_Type;
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
use Tree_Types; type Node_Type is limited record
use Ada.Finalization; Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Access;
end record;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Set is new Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Type := (Length => 0, others => null); Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Set); procedure Adjust (Container : in out Set);
procedure Finalize (Container : in out Set) renames Clear; procedure Finalize (Container : in out Set) renames Clear;
type Set_Access is access constant Set; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -285,6 +290,11 @@ private ...@@ -285,6 +290,11 @@ private
for Set'Read use Read; for Set'Read use Read;
Empty_Set : constant Set := Empty_Set : constant Set :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Indefinite_Ordered_Multisets; end Ada.Containers.Indefinite_Ordered_Multisets;
...@@ -2,11 +2,12 @@ ...@@ -2,11 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_ORDERED_SETS -- -- A D A . C O N T A I N E R S . --
-- I N D E F I N I T E _ O R D E R E D _ S E T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -56,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
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;
...@@ -68,11 +71,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -68,11 +71,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in Atlanta??? procedure Replace_Element
-- procedure Replace_Element (Container : Set; -- TODO: need ruling from ARG
-- (Container : in out Set; Position : Cursor;
-- Position : Cursor; By : Element_Type);
-- By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set); procedure Move (Target : in out Set; Source : in out Set);
...@@ -98,10 +100,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -98,10 +100,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Position : in out Cursor); Position : in out Cursor);
...@@ -110,6 +108,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -110,6 +108,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
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;
...@@ -157,10 +159,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -157,10 +159,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -220,11 +222,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -220,11 +222,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Container : Set; (Container : Set;
Key : Key_Type) return Element_Type; Key : Key_Type) return Element_Type;
-- TODO: resolve in Atlanta??? procedure Replace
-- procedure Replace (Container : in out Set; -- TODO: need ruling from ARG
-- (Container : in out Set; Key : Key_Type;
-- Key : Key_Type; New_Item : Element_Type);
-- New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_Type); procedure Delete (Container : in out Set; Key : Key_Type);
...@@ -238,8 +239,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -238,8 +239,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- TODO: resolve name in Atlanta??? procedure Update_Element_Preserving_Key
procedure Checked_Update_Element
(Container : in out Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
...@@ -252,21 +252,33 @@ private ...@@ -252,21 +252,33 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Element_Access is access Element_Type;
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
use Tree_Types; type Node_Type is limited record
use Ada.Finalization; Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Access;
end record;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Set is new Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Type := (Length => 0, others => null); Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Set); procedure Adjust (Container : in out Set);
procedure Finalize (Container : in out Set) renames Clear; procedure Finalize (Container : in out Set) renames Clear;
type Set_Access is access constant Set; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -291,6 +303,11 @@ private ...@@ -291,6 +303,11 @@ private
for Set'Read use Read; for Set'Read use Read;
Empty_Set : constant Set := Empty_Set : constant Set :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Indefinite_Ordered_Sets; end Ada.Containers.Indefinite_Ordered_Sets;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASHED_MAPS -- -- A D A . C O N T A I N E R S . H A S H E D _ M A P S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -35,6 +35,7 @@ ...@@ -35,6 +35,7 @@
with Ada.Containers.Hash_Tables; with Ada.Containers.Hash_Tables;
with Ada.Streams; with Ada.Streams;
with Ada.Finalization;
generic generic
type Key_Type is private; type Key_Type is private;
...@@ -66,8 +67,9 @@ pragma Preelaborate (Hashed_Maps); ...@@ -66,8 +67,9 @@ pragma Preelaborate (Hashed_Maps);
procedure Clear (Container : in out Map); procedure Clear (Container : in out Map);
function Element (Position : Cursor) function Key (Position : Cursor) return Key_Type;
return Element_Type;
function Element (Position : Cursor) return Element_Type;
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
...@@ -93,41 +95,36 @@ pragma Preelaborate (Hashed_Maps); ...@@ -93,41 +95,36 @@ pragma Preelaborate (Hashed_Maps);
procedure Insert procedure Insert
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); Position : out Cursor;
Inserted : out Boolean);
procedure Include procedure Insert
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Replace procedure Include
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Insert procedure Replace
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
Position : out Cursor; New_Item : Element_Type);
Inserted : out Boolean);
procedure Delete (Container : in out Map; Key : Key_Type); procedure Delete (Container : in out Map; Key : Key_Type);
procedure Exclude (Container : in out Map; Key : Key_Type);
procedure Delete (Container : in out Map; Position : in out Cursor); procedure Delete (Container : in out Map; Position : in out Cursor);
procedure Exclude (Container : in out Map; Key : Key_Type);
function Contains (Container : Map; Key : Key_Type) return Boolean; function Contains (Container : Map; Key : Key_Type) return Boolean;
function Find (Container : Map; Key : Key_Type) return Cursor; function Find (Container : Map; Key : Key_Type) return Cursor;
function Element (Container : Map; Key : Key_Type) return Element_Type; function Element (Container : Map; Key : Key_Type) return Element_Type;
function Capacity (Container : Map) return Count_Type;
procedure Reserve_Capacity (Container : in out Map;
Capacity : Count_Type);
function First (Container : Map) return Cursor; function First (Container : Map) return Cursor;
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
...@@ -136,8 +133,6 @@ pragma Preelaborate (Hashed_Maps); ...@@ -136,8 +133,6 @@ pragma Preelaborate (Hashed_Maps);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
function Key (Position : Cursor) return Key_Type;
function Equivalent_Keys (Left, Right : Cursor) return Boolean; function Equivalent_Keys (Left, Right : Cursor) return Boolean;
function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean; function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
...@@ -148,16 +143,44 @@ pragma Preelaborate (Hashed_Maps); ...@@ -148,16 +143,44 @@ pragma Preelaborate (Hashed_Maps);
(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 (Length);
pragma Inline (Is_Empty);
pragma Inline (Clear);
pragma Inline (Key);
pragma Inline (Element);
pragma Inline (Move);
pragma Inline (Contains);
pragma Inline (Capacity);
pragma Inline (Reserve_Capacity);
pragma Inline (Has_Element);
pragma Inline (Equivalent_Keys);
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package HT_Types is new Hash_Tables.Generic_Hash_Table_Types (Node_Access); type Node_Type is limited record
Key : Key_Type;
Element : Element_Type;
Next : Node_Access;
end record;
use HT_Types; package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
(Node_Type,
Node_Access);
type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
end record;
type Map is new Hash_Table_Type with null record; use HT_Types;
use Ada.Finalization;
procedure Adjust (Container : in out Map); procedure Adjust (Container : in out Map);
...@@ -177,7 +200,7 @@ private ...@@ -177,7 +200,7 @@ private
for Map'Read use Read; for Map'Read use Read;
Empty_Map : constant Map := (Hash_Table_Type with null record); Empty_Map : constant Map := (Controlled with HT => (null, 0, 0, 0));
type Map_Access is access constant Map; type Map_Access is access constant Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASHED_SETS -- -- A D A . C O N T A I N E R S . H A S H E D _ S E T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -35,16 +35,15 @@ ...@@ -35,16 +35,15 @@
with Ada.Containers.Hash_Tables; with Ada.Containers.Hash_Tables;
with Ada.Streams; with Ada.Streams;
with Ada.Finalization;
generic generic
type Element_Type is private; type Element_Type is private;
with function Hash (Element : Element_Type) return Hash_Type; with function Hash (Element : Element_Type) return Hash_Type;
-- TODO: get a ruling from ARG in Atlanta re the name and with function Equivalent_Elements (Left, Right : Element_Type)
-- order of these declarations. ??? return Boolean;
--
with function Equivalent_Keys (Left, Right : Element_Type) return Boolean;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
...@@ -61,6 +60,8 @@ pragma Preelaborate (Hashed_Sets); ...@@ -61,6 +60,8 @@ pragma Preelaborate (Hashed_Sets);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
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;
...@@ -73,11 +74,10 @@ pragma Preelaborate (Hashed_Sets); ...@@ -73,11 +74,10 @@ pragma Preelaborate (Hashed_Sets);
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in atlanta procedure Replace_Element
-- procedure Replace_Element (Container : Set;
-- (Container : in out Set; Position : Cursor;
-- Position : Cursor; By : Element_Type);
-- By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set); procedure Move (Target : in out Set; Source : in out Set);
...@@ -95,9 +95,37 @@ pragma Preelaborate (Hashed_Sets); ...@@ -95,9 +95,37 @@ pragma Preelaborate (Hashed_Sets);
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 Exclude (Container : in out Set; Item : Element_Type); procedure Exclude (Container : in out Set; Item : Element_Type);
procedure Delete (Container : in out Set; Position : in out Cursor); function Contains (Container : Set; Item : Element_Type) return Boolean;
function Find
(Container : Set;
Item : Element_Type) return Cursor;
function First (Container : Set) return Cursor;
function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
function Equivalent_Elements (Left, Right : Cursor) return Boolean;
function Equivalent_Elements
(Left : Cursor;
Right : Element_Type) return Boolean;
function Equivalent_Elements
(Left : Element_Type;
Right : Cursor) return Boolean;
procedure Iterate
(Container : Set;
Process : not null access procedure (Position : Cursor));
procedure Union (Target : in out Set; Source : Set); procedure Union (Target : in out Set; Source : Set);
...@@ -128,40 +156,12 @@ pragma Preelaborate (Hashed_Sets); ...@@ -128,40 +156,12 @@ pragma Preelaborate (Hashed_Sets);
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 Capacity (Container : Set) return Count_Type; function Capacity (Container : Set) return Count_Type;
procedure Reserve_Capacity procedure Reserve_Capacity
(Container : in out Set; (Container : in out Set;
Capacity : Count_Type); Capacity : Count_Type);
function First (Container : Set) return Cursor;
function Next (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
function Equivalent_Keys (Left, Right : Cursor) return Boolean;
function Equivalent_Keys
(Left : Cursor;
Right : Element_Type) return Boolean;
function Equivalent_Keys
(Left : Element_Type;
Right : Cursor) return Boolean;
procedure Iterate
(Container : Set;
Process : not null access procedure (Position : Cursor));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is limited private;
...@@ -183,18 +183,16 @@ pragma Preelaborate (Hashed_Sets); ...@@ -183,18 +183,16 @@ pragma Preelaborate (Hashed_Sets);
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
-- TODO: resolve in atlanta procedure Replace
-- procedure Replace (Container : in out Set;
-- (Container : in out Set; Key : Key_Type;
-- Key : Key_Type; New_Item : Element_Type);
-- New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_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);
-- TODO: resolve name in atlanta: ??? procedure Update_Element_Preserving_Key
procedure Checked_Update_Element
(Container : in out Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
...@@ -215,21 +213,32 @@ private ...@@ -215,21 +213,32 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package HT_Types is type Node_Type is
new Hash_Tables.Generic_Hash_Table_Types (Node_Access); limited record
Element : Element_Type;
Next : Node_Access;
end record;
use HT_Types; package HT_Types is new Hash_Tables.Generic_Hash_Table_Types
(Node_Type,
Node_Access);
type Set is new Hash_Table_Type with null record; type Set is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
end record;
procedure Adjust (Container : in out Set); procedure Adjust (Container : in out Set);
procedure Finalize (Container : in out Set); procedure Finalize (Container : in out Set);
type Set_Access is access constant Set; use HT_Types;
use Ada.Finalization;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is record type Cursor is
record
Container : Set_Access; Container : Set_Access;
Node : Node_Access; Node : Node_Access;
end record; end record;
...@@ -250,6 +259,6 @@ private ...@@ -250,6 +259,6 @@ private
for Set'Read use Read; for Set'Read use Read;
Empty_Set : constant Set := (Hash_Table_Type with null record); Empty_Set : constant Set := (Controlled with HT => (null, 0, 0, 0));
end Ada.Containers.Hashed_Sets; end Ada.Containers.Hashed_Sets;
...@@ -2,33 +2,55 @@ ...@@ -2,33 +2,55 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.HASH_TABLES -- -- A D A . C O N T A I N E R S . H A S H _ T A B L E S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Finalization;
package Ada.Containers.Hash_Tables is package Ada.Containers.Hash_Tables is
pragma Preelaborate; pragma Preelaborate;
generic generic
type Node_Access is private; type Node_Type (<>) is limited private;
type Node_Access is access Node_Type;
package Generic_Hash_Table_Types is package Generic_Hash_Table_Types is
type Buckets_Type is array (Hash_Type range <>) of Node_Access; type Buckets_Type is array (Hash_Type range <>) of Node_Access;
type Buckets_Access is access Buckets_Type; type Buckets_Access is access Buckets_Type;
type Hash_Table_Type is new Ada.Finalization.Controlled with record type Hash_Table_Type is tagged record
Buckets : Buckets_Access; Buckets : Buckets_Access;
Length : Count_Type := 0; Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
end Generic_Hash_Table_Types; end Generic_Hash_Table_Types;
......
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.INDEFINITE_VECTORS -- -- A D A . C O N T A I N E R S . I N D E F I N I T E _ V E C T O R S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -204,7 +204,7 @@ pragma Preelaborate (Indefinite_Vectors); ...@@ -204,7 +204,7 @@ pragma Preelaborate (Indefinite_Vectors);
procedure Delete procedure Delete
(Container : in out Vector; (Container : in out Vector;
Index : Extended_Index; -- TODO: verify Index : Extended_Index;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Delete procedure Delete
...@@ -238,7 +238,15 @@ pragma Preelaborate (Indefinite_Vectors); ...@@ -238,7 +238,15 @@ pragma Preelaborate (Indefinite_Vectors);
generic generic
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
procedure Generic_Sort (Container : Vector); package Generic_Sorting is
function Is_Sorted (Container : Vector) return Boolean;
procedure Sort (Container : in out Vector);
procedure Merge (Target, Source : in out Vector);
end Generic_Sorting;
function Find_Index function Find_Index
(Container : Vector; (Container : Vector;
...@@ -307,6 +315,8 @@ private ...@@ -307,6 +315,8 @@ private
type Vector is new Controlled with record type Vector is new Controlled with record
Elements : Elements_Access; Elements : Elements_Access;
Last : Extended_Index := No_Index; Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
procedure Adjust (Container : in out Vector); procedure Adjust (Container : in out Vector);
...@@ -327,7 +337,7 @@ private ...@@ -327,7 +337,7 @@ private
for Vector'Read use Read; for Vector'Read use Read;
Empty_Vector : constant Vector := Vector'(Controlled with null, No_Index); Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
type Vector_Access is access constant Vector; type Vector_Access is access constant Vector;
for Vector_Access'Storage_Size use 0; for Vector_Access'Storage_Size use 0;
...@@ -340,4 +350,3 @@ private ...@@ -340,4 +350,3 @@ private
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;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.VECTORS -- -- A D A . C O N T A I N E R S . V E C T O R S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -200,7 +200,7 @@ pragma Preelaborate (Vectors); ...@@ -200,7 +200,7 @@ pragma Preelaborate (Vectors);
procedure Delete procedure Delete
(Container : in out Vector; (Container : in out Vector;
Index : Extended_Index; -- TODO: verify Index : Extended_Index;
Count : Count_Type := 1); Count : Count_Type := 1);
procedure Delete procedure Delete
...@@ -234,7 +234,15 @@ pragma Preelaborate (Vectors); ...@@ -234,7 +234,15 @@ pragma Preelaborate (Vectors);
generic generic
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
procedure Generic_Sort (Container : Vector); package Generic_Sorting is
function Is_Sorted (Container : Vector) return Boolean;
procedure Sort (Container : in out Vector);
procedure Merge (Target, Source : in out Vector);
end Generic_Sorting;
function Find_Index function Find_Index
(Container : Vector; (Container : Vector;
...@@ -301,6 +309,8 @@ private ...@@ -301,6 +309,8 @@ private
type Vector is new Controlled with record type Vector is new Controlled with record
Elements : Elements_Access; Elements : Elements_Access;
Last : Extended_Index := No_Index; Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
procedure Adjust (Container : in out Vector); procedure Adjust (Container : in out Vector);
...@@ -321,7 +331,7 @@ private ...@@ -321,7 +331,7 @@ private
for Vector'Read use Read; for Vector'Read use Read;
Empty_Vector : constant Vector := (Controlled with null, No_Index); Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
type Vector_Access is access constant Vector; type Vector_Access is access constant Vector;
for Vector_Access'Storage_Size use 0; for Vector_Access'Storage_Size use 0;
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.ORDERED_MAPS -- -- A D A . C O N T A I N E R S . O R D E R E D _ M A P S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -93,34 +93,34 @@ pragma Preelaborate (Ordered_Maps); ...@@ -93,34 +93,34 @@ pragma Preelaborate (Ordered_Maps);
procedure Insert procedure Insert
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); Position : out Cursor;
Inserted : out Boolean);
procedure Include procedure Insert
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Replace procedure Include
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Insert procedure Replace
(Container : in out Map; (Container : in out Map;
Key : Key_Type; Key : Key_Type;
Position : out Cursor; New_Item : Element_Type);
Inserted : out Boolean);
procedure Delete (Container : in out Map; Key : Key_Type); procedure Delete (Container : in out Map; Key : Key_Type);
procedure Exclude (Container : in out Map; Key : Key_Type);
procedure Delete (Container : in out Map; Position : in out Cursor); procedure Delete (Container : in out Map; 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 Contains (Container : Map; Key : Key_Type) return Boolean;
function Find (Container : Map; Key : Key_Type) return Cursor; function Find (Container : Map; Key : Key_Type) return Cursor;
...@@ -145,10 +145,10 @@ pragma Preelaborate (Ordered_Maps); ...@@ -145,10 +145,10 @@ pragma Preelaborate (Ordered_Maps);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -178,21 +178,32 @@ private ...@@ -178,21 +178,32 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Node_Type is limited record
new Red_Black_Trees.Generic_Tree_Types (Node_Access); Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Key : Key_Type;
Element : Element_Type;
end record;
use Tree_Types; package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
use Ada.Finalization; (Node_Type,
Node_Access);
type Map is new Controlled with record type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Type := (Length => 0, others => null); Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Map); procedure Adjust (Container : in out Map);
procedure Finalize (Container : in out Map) renames Clear; procedure Finalize (Container : in out Map) renames Clear;
type Map_Access is access constant Map; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Map_Access is access Map;
for Map_Access'Storage_Size use 0; for Map_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -210,7 +221,6 @@ private ...@@ -210,7 +221,6 @@ private
for Map'Write use Write; for Map'Write use Write;
procedure Read procedure Read
(Stream : access Root_Stream_Type'Class; (Stream : access Root_Stream_Type'Class;
Container : out Map); Container : out Map);
...@@ -218,6 +228,11 @@ private ...@@ -218,6 +228,11 @@ private
for Map'Read use Read; for Map'Read use Read;
Empty_Map : constant Map := Empty_Map : constant Map :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Ordered_Maps; end Ada.Containers.Ordered_Maps;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.ORDERED_MULTISETS -- -- A D A . C O N T A I N E R S . O R D E R E D _ M U L T I S E T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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,6 +56,8 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -56,6 +56,8 @@ pragma Preelaborate (Ordered_Multisets);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
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;
...@@ -68,6 +70,11 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -68,6 +70,11 @@ pragma Preelaborate (Ordered_Multisets);
(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 procedure Move
(Target : in out Set; (Target : in out Set;
Source : in out Set); Source : in out Set);
...@@ -85,10 +92,6 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -85,10 +92,6 @@ pragma Preelaborate (Ordered_Multisets);
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Position : in out Cursor); Position : in out Cursor);
...@@ -97,13 +100,9 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -97,13 +100,9 @@ pragma Preelaborate (Ordered_Multisets);
procedure Delete_Last (Container : in out Set); procedure Delete_Last (Container : in out Set);
-- NOTE: The following operation is named Replace in the Madison API. procedure Exclude
-- However, it should be named Replace_Element. ??? (Container : in out Set;
-- Item : Element_Type);
-- procedure Replace
-- (Container : in out Set;
-- Position : Cursor;
-- By : Element_Type);
procedure Union (Target : in out Set; Source : Set); procedure Union (Target : in out Set; Source : Set);
...@@ -151,10 +150,10 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -151,10 +150,10 @@ pragma Preelaborate (Ordered_Multisets);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -214,12 +213,6 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -214,12 +213,6 @@ pragma Preelaborate (Ordered_Multisets);
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
-- NOTE: in post-madison api ???
-- procedure Replace
-- (Container : in out Set;
-- Key : Key_Type;
-- New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_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);
...@@ -232,9 +225,7 @@ pragma Preelaborate (Ordered_Multisets); ...@@ -232,9 +225,7 @@ pragma Preelaborate (Ordered_Multisets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- Should name of following be "Update_Element" ??? procedure Update_Element_Preserving_Key
procedure Checked_Update_Element
(Container : in out Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
...@@ -257,21 +248,31 @@ private ...@@ -257,21 +248,31 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Node_Type is limited record
new Red_Black_Trees.Generic_Tree_Types (Node_Access); Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Type;
end record;
use Tree_Types; package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
use Ada.Finalization; (Node_Type,
Node_Access);
type Set is new Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Type := (Length => 0, others => null); Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Set); procedure Adjust (Container : in out Set);
procedure Finalize (Container : in out Set) renames Clear; procedure Finalize (Container : in out Set) renames Clear;
type Set_Access is access constant Set; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0; for Set_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
...@@ -296,6 +297,11 @@ private ...@@ -296,6 +297,11 @@ private
for Set'Read use Read; for Set'Read use Read;
Empty_Set : constant Set := Empty_Set : constant Set :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Ordered_Multisets; end Ada.Containers.Ordered_Multisets;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.ORDERED_SETS -- -- A D A . C O N T A I N E R S . O R D E R E D _ S E T S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004 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,8 @@ pragma Preelaborate (Ordered_Sets); ...@@ -57,6 +57,8 @@ pragma Preelaborate (Ordered_Sets);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
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;
...@@ -69,11 +71,10 @@ pragma Preelaborate (Ordered_Sets); ...@@ -69,11 +71,10 @@ pragma Preelaborate (Ordered_Sets);
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in Atlanta. ??? procedure Replace_Element
-- procedure Replace_Element (Container : Set; -- TODO: need ARG ruling
-- (Container : in out Set; Position : Cursor;
-- Position : Cursor; By : Element_Type);
-- By : Element_Type);
procedure Move procedure Move
(Target : in out Set; (Target : in out Set;
...@@ -94,17 +95,13 @@ pragma Preelaborate (Ordered_Sets); ...@@ -94,17 +95,13 @@ pragma Preelaborate (Ordered_Sets);
New_Item : Element_Type); New_Item : Element_Type);
procedure Replace procedure Replace
(Container : in out Set; (Container : in out Set; -- TODO: need ARG ruling
New_Item : Element_Type); New_Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Position : in out Cursor); Position : in out Cursor);
...@@ -113,6 +110,10 @@ pragma Preelaborate (Ordered_Sets); ...@@ -113,6 +110,10 @@ pragma Preelaborate (Ordered_Sets);
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;
...@@ -160,10 +161,10 @@ pragma Preelaborate (Ordered_Sets); ...@@ -160,10 +161,10 @@ pragma Preelaborate (Ordered_Sets);
function Next (Position : Cursor) return Cursor; function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor); procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
...@@ -215,11 +216,10 @@ pragma Preelaborate (Ordered_Sets); ...@@ -215,11 +216,10 @@ pragma Preelaborate (Ordered_Sets);
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
-- TODO: resolve in Atlanta ??? procedure Replace
-- procedure Replace (Container : in out Set; -- TODO: need ARG ruling
-- (Container : in out Set; Key : Key_Type;
-- Key : Key_Type; New_Item : Element_Type);
-- New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_Type); procedure Delete (Container : in out Set; Key : Key_Type);
...@@ -233,8 +233,7 @@ pragma Preelaborate (Ordered_Sets); ...@@ -233,8 +233,7 @@ pragma Preelaborate (Ordered_Sets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- TODO: resolve name in Atlanta. Should name be just "Update_Element" ??? procedure Update_Element_Preserving_Key
procedure Checked_Update_Element
(Container : in out Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
Process : not null access Process : not null access
...@@ -247,21 +246,32 @@ private ...@@ -247,21 +246,32 @@ private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
package Tree_Types is type Node_Type is limited record
new Red_Black_Trees.Generic_Tree_Types (Node_Access); Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Type;
end record;
use Tree_Types; package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
use Ada.Finalization; (Node_Type,
Node_Access);
type Set is new Controlled with record type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Type := (Length => 0, others => null); Tree : Tree_Types.Tree_Type;
end record; end record;
procedure Adjust (Container : in out Set); procedure Adjust (Container : in out Set);
procedure Finalize (Container : in out Set) renames Clear; procedure Finalize (Container : in out Set) renames Clear;
type Set_Access is access constant Set; use Red_Black_Trees;
use Tree_Types;
use Ada.Finalization;
type Set_Access is access all Set;
for Set_Access'Storage_Size use 0;
type Cursor is record type Cursor is record
Container : Set_Access; Container : Set_Access;
...@@ -285,6 +295,11 @@ private ...@@ -285,6 +295,11 @@ private
for Set'Read use Read; for Set'Read use Read;
Empty_Set : constant Set := Empty_Set : constant Set :=
(Controlled with Tree => (Length => 0, others => null)); (Controlled with Tree => (First => null,
Last => null,
Root => null,
Length => 0,
Busy => 0,
Lock => 0));
end Ada.Containers.Ordered_Sets; end Ada.Containers.Ordered_Sets;
...@@ -2,15 +2,35 @@ ...@@ -2,15 +2,35 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.RED_BLACK_TREES -- -- A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
package Ada.Containers.Red_Black_Trees is package Ada.Containers.Red_Black_Trees is
...@@ -19,13 +39,17 @@ pragma Pure (Red_Black_Trees); ...@@ -19,13 +39,17 @@ pragma Pure (Red_Black_Trees);
type Color_Type is (Red, Black); type Color_Type is (Red, Black);
generic generic
type Node_Access is private; type Node_Type (<>) is limited private;
type Node_Access is access Node_Type;
package Generic_Tree_Types is package Generic_Tree_Types is
type Tree_Type is record type Tree_Type is tagged record
First : Node_Access; First : Node_Access;
Last : Node_Access; Last : Node_Access;
Root : Node_Access; Root : Node_Access;
Length : Count_Type; Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record; end record;
end Generic_Tree_Types; end Generic_Tree_Types;
end Ada.Containers.Red_Black_Trees; end Ada.Containers.Red_Black_Trees;
...@@ -2,7 +2,8 @@ ...@@ -2,7 +2,8 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_KEYS -- -- A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S . --
-- G E N E R I C _ K E Y S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
...@@ -133,6 +134,3 @@ pragma Pure (Generic_Keys); ...@@ -133,6 +134,3 @@ pragma Pure (Generic_Keys);
Key : Key_Type); Key : Key_Type);
end Ada.Containers.Red_Black_Trees.Generic_Keys; end Ada.Containers.Red_Black_Trees.Generic_Keys;
...@@ -2,23 +2,44 @@ ...@@ -2,23 +2,44 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_OPERATIONS -- -- A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S . --
-- G E N E R I C _ O P E R A T I O N S --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- -- -- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This unit was originally developed by Matthew J Heaney. --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Streams; use Ada.Streams;
generic generic
with package Tree_Types is new Generic_Tree_Types (<>); with package Tree_Types is new Generic_Tree_Types (<>);
use Tree_Types; use Tree_Types;
Null_Node : Node_Access;
with function Parent (Node : Node_Access) return Node_Access is <>; with function Parent (Node : Node_Access) return Node_Access is <>;
with procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is <>; with procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is <>;
with function Left (Node : Node_Access) return Node_Access is <>; with function Left (Node : Node_Access) return Node_Access is <>;
...@@ -41,8 +62,6 @@ pragma Pure; ...@@ -41,8 +62,6 @@ pragma Pure;
function Previous (Node : Node_Access) return Node_Access; function Previous (Node : Node_Access) return Node_Access;
procedure Move (Target, Source : in out Tree_Type);
generic generic
with function Is_Equal (L, R : Node_Access) return Boolean; with function Is_Equal (L, R : Node_Access) return Boolean;
function Generic_Equal (Left, Right : Tree_Type) return Boolean; function Generic_Equal (Left, Right : Tree_Type) return Boolean;
...@@ -52,6 +71,27 @@ pragma Pure; ...@@ -52,6 +71,27 @@ pragma Pure;
Node : Node_Access); Node : Node_Access);
generic generic
with procedure Free (X : in out Node_Access);
procedure Generic_Delete_Tree (X : in out Node_Access);
generic
with function Copy_Node (Source : Node_Access) return Node_Access;
with procedure Delete_Tree (X : in out Node_Access);
function Generic_Copy_Tree (Source_Root : Node_Access) return Node_Access;
generic
with function Copy_Tree (Root : Node_Access) return Node_Access;
procedure Generic_Adjust (Tree : in out Tree_Type);
generic
with procedure Delete_Tree (X : in out Node_Access);
procedure Generic_Clear (Tree : in out Tree_Type);
generic
with procedure Clear (Tree : in out Tree_Type);
procedure Generic_Move (Target, Source : in out Tree_Type);
generic
with procedure Process (Node : Node_Access) is <>; with procedure Process (Node : Node_Access) is <>;
procedure Generic_Iteration (Tree : Tree_Type); procedure Generic_Iteration (Tree : Tree_Type);
...@@ -60,8 +100,20 @@ pragma Pure; ...@@ -60,8 +100,20 @@ pragma Pure;
procedure Generic_Reverse_Iteration (Tree : Tree_Type); procedure Generic_Reverse_Iteration (Tree : Tree_Type);
generic generic
with function New_Node return Node_Access is <>; with procedure Write_Node
procedure Generic_Read (Tree : in out Tree_Type; N : Count_Type); (Stream : access Root_Stream_Type'Class;
Node : Node_Access);
procedure Generic_Write
(Stream : access Root_Stream_Type'Class;
Tree : Tree_Type);
generic
with procedure Clear (Tree : in out Tree_Type);
with function Read_Node
(Stream : access Root_Stream_Type'Class) return Node_Access;
procedure Generic_Read
(Stream : access Root_Stream_Type'Class;
Tree : in out Tree_Type);
procedure Rebalance_For_Insert procedure Rebalance_For_Insert
(Tree : in out Tree_Type; (Tree : in out Tree_Type;
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.HASH_CASE_INSENSITIVE -- -- A D A . S T R I N G S . H A S H _ C A S E _ I N S E N S I T I V E --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -52,17 +52,8 @@ is ...@@ -52,17 +52,8 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in Key'Range loop for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 1) + Character'Pos (To_Lower (Key (J))); Tmp := Rotate_Left (Tmp, 3) + Character'Pos (To_Lower (Key (J)));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Hash_Case_Insensitive; end Ada.Strings.Hash_Case_Insensitive;
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.HASH_CASE_INSENSITIVE -- -- A D A . S T R I N G S . H A S H _ C A S E _ I N S E N S I T I V E --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.HASH -- -- A D A . S T R I N G S . H A S H --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -48,16 +48,8 @@ function Ada.Strings.Hash (Key : String) return Containers.Hash_Type is ...@@ -48,16 +48,8 @@ function Ada.Strings.Hash (Key : String) return Containers.Hash_Type is
begin begin
Tmp := 0; Tmp := 0;
for J in Key'Range loop for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key (J)); Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key (J));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Hash; end Ada.Strings.Hash;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.UNBOUNDED.HASH -- -- A D A . S T R I N G S . U N B O U N D E D . H A S H --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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,7 +50,7 @@ is ...@@ -50,7 +50,7 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in 1 .. Key.Last loop for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key.Reference (J)); Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Key.Reference (J));
end loop; end loop;
return Tmp; return Tmp;
......
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.WIDE_HASH -- -- A D A . S T R I N G S . W I D E _ H A S H --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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,10 +50,8 @@ is ...@@ -50,10 +50,8 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in Key'Range loop for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 1) + Wide_Character'Pos (Key (J)); Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key (J));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Wide_Hash; end Ada.Strings.Wide_Hash;
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.WIDE_HASH -- -- A D A . S T R I N G S . W I D E _ H A S H --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
...@@ -19,6 +19,3 @@ function Ada.Strings.Wide_Hash ...@@ -19,6 +19,3 @@ function Ada.Strings.Wide_Hash
(Key : Wide_String) return Containers.Hash_Type; (Key : Wide_String) return Containers.Hash_Type;
pragma Pure (Ada.Strings.Wide_Hash); pragma Pure (Ada.Strings.Wide_Hash);
...@@ -50,10 +50,8 @@ is ...@@ -50,10 +50,8 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in Key'Range loop for J in Key'Range loop
Tmp := Rotate_Left (Tmp, 1) + Wide_Wide_Character'Pos (Key (J)); Tmp := Rotate_Left (Tmp, 3) + Wide_Wide_Character'Pos (Key (J));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Wide_Wide_Hash; end Ada.Strings.Wide_Wide_Hash;
...@@ -2,11 +2,11 @@ ...@@ -2,11 +2,11 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.WIDE_UNBOUNDED.HASH -- -- A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004 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 --
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) -- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
function Ada.Strings.Wide_Unbounded.Hash function Ada.Strings.Wide_Unbounded.Wide_Hash
(Key : Unbounded_Wide_String) return Containers.Hash_Type (Key : Unbounded_Wide_String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
...@@ -50,8 +50,8 @@ is ...@@ -50,8 +50,8 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in 1 .. Key.Last loop for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 1) + Wide_Character'Pos (Key.Reference (J)); Tmp := Rotate_Left (Tmp, 3) + Wide_Character'Pos (Key.Reference (J));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Wide_Unbounded.Hash; end Ada.Strings.Wide_Unbounded.Wide_Hash;
...@@ -2,10 +2,12 @@ ...@@ -2,10 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- ADA.STRINGS.WIDE_UNBOUNDED.HASH -- -- A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
...@@ -15,7 +17,7 @@ ...@@ -15,7 +17,7 @@
with Ada.Containers; with Ada.Containers;
function Ada.Strings.Wide_Unbounded.Hash function Ada.Strings.Wide_Unbounded.Wide_Hash
(Key : Unbounded_Wide_String) return Containers.Hash_Type; (Key : Unbounded_Wide_String) return Containers.Hash_Type;
pragma Preelaborate (Ada.Strings.Wide_Unbounded.Hash); pragma Preelaborate (Ada.Strings.Wide_Unbounded.Wide_Hash);
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- A D A . S T R I N G S . W I D E _ U N B O U N D E D . H A S H -- -- A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
...@@ -35,7 +35,7 @@ ...@@ -35,7 +35,7 @@
-- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb) -- Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
function Ada.Strings.Wide_Wide_Unbounded.Hash function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
(Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type
is is
use Ada.Containers; use Ada.Containers;
...@@ -50,9 +50,9 @@ is ...@@ -50,9 +50,9 @@ is
begin begin
Tmp := 0; Tmp := 0;
for J in 1 .. Key.Last loop for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 1) + Tmp := Rotate_Left (Tmp, 3) +
Wide_Wide_Character'Pos (Key.Reference (J)); Wide_Wide_Character'Pos (Key.Reference (J));
end loop; end loop;
return Tmp; return Tmp;
end Ada.Strings.Wide_Wide_Unbounded.Hash; end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash;
...@@ -2,10 +2,12 @@ ...@@ -2,10 +2,12 @@
-- -- -- --
-- GNAT LIBRARY COMPONENTS -- -- GNAT LIBRARY COMPONENTS --
-- -- -- --
-- A D A . S T R I N G S . W I D E _ U N B O U N D E D . H A S H -- -- A D A . S T R I N G S . W I D E _ U N B O U N D E D . W I D E _ H A S H --
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with -- -- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely -- -- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a -- -- copy and modify this specification, provided that if you redistribute a --
...@@ -15,7 +17,7 @@ ...@@ -15,7 +17,7 @@
with Ada.Containers; with Ada.Containers;
function Ada.Strings.Wide_Wide_Unbounded.Hash function Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash
(Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type; (Key : Unbounded_Wide_Wide_String) return Containers.Hash_Type;
pragma Preelaborate (Ada.Strings.Wide_Wide_Unbounded.Hash); pragma Preelaborate (Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash);
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