Skip to content

R
riscv-gcc-1
Commit 8704d4b3 by Matthew Heaney Committed by Arnaud Charlet
Options

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
Showing with 741 additions and 478 deletions
gcc/ada/a-cdlili.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -122,18 +122,20 @@ package Ada.Containers.Doubly_Linked_Lists is
Count : Count_Type := 1);
generic
with function "<" (Left, Right : Element_Type)
return Boolean is <>;
procedure Generic_Sort (Container : in out List);
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
generic
with function "<" (Left, Right : Element_Type)
return Boolean is <>;
procedure Generic_Merge (Target : in out List; Source : in out List);
function Is_Sorted (Container : List) return Boolean;
procedure Sort (Container : in out List);
procedure Merge (Target, Source : in out List);
end Generic_Sorting;
procedure Reverse_List (Container : in out List);
procedure Swap (I, J : in Cursor);
procedure Swap (I, J : Cursor);
procedure Swap_Links
(Container : in out List;
......@@ -153,7 +155,7 @@ package Ada.Containers.Doubly_Linked_Lists is
(Target : in out List;
Before : Cursor;
Source : in out List;
Position : Cursor);
Position : in out Cursor);
function First (Container : List) return Cursor;
......@@ -200,14 +202,12 @@ private
type Node_Access is access Node_Type;
type Node_Type is
record
limited record
Element : Element_Type;
Next : Node_Access;
Prev : Node_Access;
end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
use Ada.Finalization;
type List is
......@@ -215,6 +215,8 @@ private
First : Node_Access;
Last : Node_Access;
Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
procedure Adjust (Container : in out List);
......@@ -235,7 +237,7 @@ private
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;
for List_Access'Storage_Size use 0;
......@@ -249,4 +251,3 @@ private
No_Element : constant Cursor := Cursor'(null, null);
end Ada.Containers.Doubly_Linked_Lists;
gcc/ada/a-chtgke.adb
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -40,7 +41,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
--------------------------
procedure Delete_Key_Sans_Free
(HT : in out HT_Type;
(HT : in out Hash_Table_Type;
Key : Key_Type;
X : out Node_Access)
is
......@@ -49,18 +50,21 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
begin
if HT.Length = 0 then
X := Null_Node;
X := null;
return;
end if;
Indx := Index (HT, Key);
X := HT.Buckets (Indx);
if X = Null_Node then
if X = null then
return;
end if;
if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
raise Program_Error;
end if;
HT.Buckets (Indx) := Next (X);
HT.Length := HT.Length - 1;
return;
......@@ -70,11 +74,14 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
Prev := X;
X := Next (Prev);
if X = Null_Node then
if X = null then
return;
end if;
if Equivalent_Keys (Key, X) then
if HT.Busy > 0 then
raise Program_Error;
end if;
Set_Next (Node => Prev, Next => Next (X));
HT.Length := HT.Length - 1;
return;
......@@ -87,7 +94,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
----------
function Find
(HT : HT_Type;
(HT : Hash_Table_Type;
Key : Key_Type) return Node_Access is
Indx : Hash_Type;
......@@ -95,20 +102,20 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
begin
if HT.Length = 0 then
return Null_Node;
return null;
end if;
Indx := Index (HT, Key);
Node := HT.Buckets (Indx);
while Node /= Null_Node loop
while Node /= null loop
if Equivalent_Keys (Key, Node) then
return Node;
end if;
Node := Next (Node);
end loop;
return Null_Node;
return null;
end Find;
--------------------------------
......@@ -116,10 +123,10 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
--------------------------------
procedure Generic_Conditional_Insert
(HT : in out HT_Type;
Key : Key_Type;
Node : out Node_Access;
Success : out Boolean)
(HT : in out Hash_Table_Type;
Key : Key_Type;
Node : out Node_Access;
Inserted : out Boolean)
is
Indx : constant Hash_Type := Index (HT, Key);
B : Node_Access renames HT.Buckets (Indx);
......@@ -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;
begin
if B = Null_Node then
if B = null then
if HT.Busy > 0 then
raise Program_Error;
end if;
declare
Length : constant Length_Subtype := HT.Length;
begin
Node := New_Node (Next => Null_Node);
Success := True;
Node := New_Node (Next => null);
Inserted := True;
B := Node;
HT.Length := Length + 1;
......@@ -144,20 +155,24 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
Node := B;
loop
if Equivalent_Keys (Key, Node) then
Success := False;
Inserted := False;
return;
end if;
Node := Next (Node);
exit when Node = Null_Node;
exit when Node = null;
end loop;
if HT.Busy > 0 then
raise Program_Error;
end if;
declare
Length : constant Length_Subtype := HT.Length;
begin
Node := New_Node (Next => B);
Success := True;
Inserted := True;
B := Node;
HT.Length := Length + 1;
......@@ -169,7 +184,7 @@ package body Ada.Containers.Hash_Tables.Generic_Keys is
-----------
function Index
(HT : HT_Type;
(HT : Hash_Table_Type;
Key : Key_Type) return Hash_Type is
begin
return Hash (Key) mod HT.Buckets'Length;
......
gcc/ada/a-chtgke.ads
......@@ -2,27 +2,44 @@
-- --
-- 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 --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- 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. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- 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
with package HT_Types is
new Generic_Hash_Table_Types (<>);
type HT_Type is new HT_Types.Hash_Table_Type with private;
use HT_Types;
Null_Node : Node_Access;
with function Next (Node : Node_Access) return Node_Access;
with procedure Set_Next
......@@ -41,24 +58,24 @@ package Ada.Containers.Hash_Tables.Generic_Keys is
pragma Preelaborate;
function Index
(HT : HT_Type;
(HT : Hash_Table_Type;
Key : Key_Type) return Hash_Type;
pragma Inline (Index);
procedure Delete_Key_Sans_Free
(HT : in out HT_Type;
(HT : in out Hash_Table_Type;
Key : Key_Type;
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
with function New_Node
(Next : Node_Access) return Node_Access;
procedure Generic_Conditional_Insert
(HT : in out HT_Type;
Key : Key_Type;
Node : out Node_Access;
Success : out Boolean);
(HT : in out Hash_Table_Type;
Key : Key_Type;
Node : out Node_Access;
Inserted : out Boolean);
end Ada.Containers.Hash_Tables.Generic_Keys;
gcc/ada/a-chtgop.ads
......@@ -2,12 +2,11 @@
-- --
-- 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 --
-- --
-- Copyright (C) 2004 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
......@@ -22,12 +21,8 @@ generic
with package HT_Types is
new Generic_Hash_Table_Types (<>);
type Hash_Table_Type is new HT_Types.Hash_Table_Type with private;
use HT_Types;
Null_Node : in Node_Access;
with function Hash_Node (Node : Node_Access) return Hash_Type;
with function Next (Node : Node_Access) return Node_Access;
......@@ -72,7 +67,7 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
function Capacity (HT : Hash_Table_Type) return Count_Type;
procedure Ensure_Capacity
procedure Reserve_Capacity
(HT : in out Hash_Table_Type;
N : Count_Type);
......@@ -108,4 +103,3 @@ package Ada.Containers.Hash_Tables.Generic_Operations is
HT : out Hash_Table_Type);
end Ada.Containers.Hash_Tables.Generic_Operations;
gcc/ada/a-cidlli.ads
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -118,16 +119,16 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
Count : Count_Type := 1);
generic
with function "<" (Left, Right : Element_Type)
return Boolean is <>;
procedure Generic_Sort (Container : in out List);
with function "<" (Left, Right : Element_Type) return Boolean is <>;
package Generic_Sorting is
generic
with function "<" (Left, Right : Element_Type)
return Boolean is <>;
procedure Generic_Merge
(Target : in out List;
Source : in out List);
function Is_Sorted (Container : List) return Boolean;
procedure Sort (Container : in out List);
procedure Merge (Target, Source : in out List);
end Generic_Sorting;
procedure Reverse_List (Container : in out List);
......@@ -149,7 +150,7 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
(Target : in out List;
Before : Cursor;
Source : in out List;
Position : Cursor);
Position : in out Cursor);
function First (Container : List) return Cursor;
......@@ -198,14 +199,12 @@ private
type Element_Access is access Element_Type;
type Node_Type is
record
limited record
Element : Element_Access;
Next : Node_Access;
Prev : Node_Access;
end record;
function "=" (L, R : Node_Type) return Boolean is abstract;
use Ada.Finalization;
type List is
......@@ -213,6 +212,8 @@ private
First : Node_Access;
Last : Node_Access;
Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
procedure Adjust (Container : in out List);
......@@ -233,7 +234,7 @@ private
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;
for List_Access'Storage_Size use 0;
......@@ -247,5 +248,3 @@ private
No_Element : constant Cursor := Cursor'(null, null);
end Ada.Containers.Indefinite_Doubly_Linked_Lists;
gcc/ada/a-cihama.ads
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,6 +36,7 @@
with Ada.Containers.Hash_Tables;
with Ada.Streams;
with Ada.Finalization;
generic
type Key_Type (<>) is private;
......@@ -61,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Maps is
procedure Clear (Container : in out Map);
function Key (Position : Cursor) return Key_Type;
function Element (Position : Cursor) return Element_Type;
procedure Query_Element
......@@ -105,14 +109,14 @@ package Ada.Containers.Indefinite_Hashed_Maps is
(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 Exclude
(Container : in out Map;
Key : Key_Type);
function Contains
(Container : Map;
Key : Key_Type) return Boolean;
......@@ -125,12 +129,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
(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 Next (Position : Cursor) return Cursor;
......@@ -139,8 +137,6 @@ package Ada.Containers.Indefinite_Hashed_Maps is
function Has_Element (Position : Cursor) return Boolean;
function Key (Position : Cursor) return Key_Type;
function Equivalent_Keys (Left, Right : Cursor)
return Boolean;
......@@ -156,16 +152,48 @@ package Ada.Containers.Indefinite_Hashed_Maps is
(Container : Map;
Process : not null access procedure (Position : Cursor));
function Capacity (Container : Map) return Count_Type;
procedure Reserve_Capacity
(Container : in out Map;
Capacity : Count_Type);
private
pragma Inline ("=");
pragma Inline (Length);
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_Access is access Node_Type;
package HT_Types is
new Hash_Tables.Generic_Hash_Table_Types (Node_Access);
type Key_Access is access Key_Type;
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);
......@@ -198,9 +226,6 @@ private
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;
gcc/ada/a-ciorma.ads
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -110,10 +111,6 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
(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);
......@@ -122,6 +119,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
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;
......@@ -156,10 +157,10 @@ pragma Preelaborate (Indefinite_Ordered_Maps);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -189,21 +190,35 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Key_Access is access Key_Type;
type Element_Access is access Element_Type;
use Tree_Types;
use Ada.Finalization;
type Node_Type is limited record
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
Tree : Tree_Type := (Length => 0, others => null);
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Map);
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;
type Cursor is record
......@@ -228,7 +243,11 @@ private
for Map'Read use Read;
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;
gcc/ada/a-ciormu.ads
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -56,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
function Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean;
......@@ -68,6 +71,11 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Replace_Element
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set);
procedure Insert
......@@ -79,22 +87,13 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
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_First (Container : in out Set);
procedure Delete_Last (Container : in out Set);
-- 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 Exclude (Container : in out Set; Item : Element_Type);
procedure Union (Target : in out Set;
Source : Set);
......@@ -143,10 +142,10 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -207,12 +206,6 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
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 Exclude (Container : in out Set; Key : Key_Type);
......@@ -225,7 +218,7 @@ pragma Preelaborate (Indefinite_Ordered_Multisets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
procedure Checked_Update_Element
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
......@@ -248,21 +241,33 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Element_Access is access Element_Type;
use Tree_Types;
use Ada.Finalization;
type Node_Type is limited record
Parent : Node_Access;
Left : Node_Access;
Right : Node_Access;
Color : Red_Black_Trees.Color_Type := Red_Black_Trees.Red;
Element : Element_Access;
end record;
type Set is new Controlled with record
Tree : Tree_Type := (Length => 0, others => null);
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Set);
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
......@@ -285,6 +290,11 @@ private
for Set'Read use Read;
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;
gcc/ada/a-ciorse.ads
......@@ -2,11 +2,12 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -56,6 +57,8 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
function Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean;
......@@ -68,11 +71,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in Atlanta???
-- procedure Replace_Element
-- (Container : in out Set;
-- Position : Cursor;
-- By : Element_Type);
procedure Replace_Element
(Container : Set; -- TODO: need ruling from ARG
Position : Cursor;
By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set);
......@@ -98,10 +100,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(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);
......@@ -110,6 +108,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
procedure Delete_Last (Container : in out Set);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Union (Target : in out Set; Source : Set);
function Union (Left, Right : Set) return Set;
......@@ -157,10 +159,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -220,11 +222,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Container : Set;
Key : Key_Type) return Element_Type;
-- TODO: resolve in Atlanta???
-- procedure Replace
-- (Container : in out Set;
-- Key : Key_Type;
-- New_Item : Element_Type);
procedure Replace
(Container : in out Set; -- TODO: need ruling from ARG
Key : Key_Type;
New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_Type);
......@@ -238,8 +239,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- TODO: resolve name in Atlanta???
procedure Checked_Update_Element
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
......@@ -252,21 +252,33 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Element_Access is access Element_Type;
use Tree_Types;
use Ada.Finalization;
type Node_Type is limited record
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
Tree : Tree_Type := (Length => 0, others => null);
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Set);
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
......@@ -291,6 +303,11 @@ private
for Set'Read use Read;
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;
gcc/ada/a-cohama.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,6 +35,7 @@
with Ada.Containers.Hash_Tables;
with Ada.Streams;
with Ada.Finalization;
generic
type Key_Type is private;
......@@ -66,8 +67,9 @@ pragma Preelaborate (Hashed_Maps);
procedure Clear (Container : in out Map);
function Element (Position : Cursor)
return Element_Type;
function Key (Position : Cursor) return Key_Type;
function Element (Position : Cursor) return Element_Type;
procedure Query_Element
(Position : Cursor;
......@@ -93,41 +95,36 @@ pragma Preelaborate (Hashed_Maps);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
Position : out Cursor;
Inserted : out Boolean);
procedure Include
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Replace
procedure Include
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Insert
procedure Replace
(Container : in out Map;
Key : Key_Type;
Position : out Cursor;
Inserted : out Boolean);
New_Item : Element_Type);
procedure Delete (Container : in out Map; Key : Key_Type);
procedure Exclude (Container : in out Map; Key : Key_Type);
procedure Delete (Container : in out Map; Position : in out Cursor);
procedure Exclude (Container : in out Map; Key : Key_Type);
function Contains (Container : Map; Key : Key_Type) return Boolean;
function Find (Container : Map; Key : Key_Type) return Cursor;
function Element (Container : Map; Key : Key_Type) return Element_Type;
function Capacity (Container : Map) return Count_Type;
procedure Reserve_Capacity (Container : in out Map;
Capacity : Count_Type);
function First (Container : Map) return Cursor;
function Next (Position : Cursor) return Cursor;
......@@ -136,8 +133,6 @@ pragma Preelaborate (Hashed_Maps);
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 : Cursor; Right : Key_Type) return Boolean;
......@@ -148,16 +143,44 @@ pragma Preelaborate (Hashed_Maps);
(Container : Map;
Process : not null access procedure (Position : Cursor));
function Capacity (Container : Map) return Count_Type;
procedure Reserve_Capacity (Container : in out Map;
Capacity : Count_Type);
private
pragma Inline ("=");
pragma Inline (Length);
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_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 Hash_Table_Type with null record;
type Map is new Ada.Finalization.Controlled with record
HT : HT_Types.Hash_Table_Type;
end record;
use HT_Types;
use Ada.Finalization;
procedure Adjust (Container : in out Map);
......@@ -177,7 +200,7 @@ private
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;
for Map_Access'Storage_Size use 0;
......
gcc/ada/a-cohase.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,16 +35,15 @@
with Ada.Containers.Hash_Tables;
with Ada.Streams;
with Ada.Finalization;
generic
type Element_Type is private;
with function Hash (Element : Element_Type) return Hash_Type;
-- TODO: get a ruling from ARG in Atlanta re the name and
-- order of these declarations. ???
--
with function Equivalent_Keys (Left, Right : Element_Type) return Boolean;
with function Equivalent_Elements (Left, Right : Element_Type)
return Boolean;
with function "=" (Left, Right : Element_Type) return Boolean is <>;
......@@ -61,6 +60,8 @@ pragma Preelaborate (Hashed_Sets);
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
function Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean;
......@@ -73,11 +74,10 @@ pragma Preelaborate (Hashed_Sets);
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in atlanta
-- procedure Replace_Element
-- (Container : in out Set;
-- Position : Cursor;
-- By : Element_Type);
procedure Replace_Element
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set);
......@@ -95,9 +95,37 @@ pragma Preelaborate (Hashed_Sets);
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 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);
......@@ -128,40 +156,12 @@ pragma Preelaborate (Hashed_Sets);
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;
procedure Reserve_Capacity
(Container : in out Set;
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
type Key_Type (<>) is limited private;
......@@ -183,18 +183,16 @@ pragma Preelaborate (Hashed_Sets);
function Element (Container : Set; Key : Key_Type) return Element_Type;
-- TODO: resolve in atlanta
-- procedure Replace
-- (Container : in out Set;
-- Key : Key_Type;
-- New_Item : Element_Type);
procedure Replace
(Container : in out Set;
Key : Key_Type;
New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_Type);
procedure Exclude (Container : in out Set; Key : Key_Type);
-- TODO: resolve name in atlanta: ???
procedure Checked_Update_Element
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
......@@ -215,24 +213,35 @@ private
type 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
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 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;
type Cursor is record
Container : Set_Access;
Node : Node_Access;
end record;
type Cursor is
record
Container : Set_Access;
Node : Node_Access;
end record;
No_Element : constant Cursor := (Container => null, Node => null);
......@@ -250,6 +259,6 @@ private
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;
gcc/ada/a-cohata.ads
......@@ -2,33 +2,55 @@
-- --
-- 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 --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- 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. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- 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
pragma Preelaborate;
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
type Buckets_Type is array (Hash_Type range <>) of Node_Access;
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;
Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
end Generic_Hash_Table_Types;
......
gcc/ada/a-coinve.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/a-coinve.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -204,7 +204,7 @@ pragma Preelaborate (Indefinite_Vectors);
procedure Delete
(Container : in out Vector;
Index : Extended_Index; -- TODO: verify
Index : Extended_Index;
Count : Count_Type := 1);
procedure Delete
......@@ -238,7 +238,15 @@ pragma Preelaborate (Indefinite_Vectors);
generic
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
(Container : Vector;
......@@ -307,6 +315,8 @@ private
type Vector is new Controlled with record
Elements : Elements_Access;
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
procedure Adjust (Container : in out Vector);
......@@ -327,7 +337,7 @@ private
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;
for Vector_Access'Storage_Size use 0;
......@@ -340,4 +350,3 @@ private
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
end Ada.Containers.Indefinite_Vectors;
gcc/ada/a-convec.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -200,7 +200,7 @@ pragma Preelaborate (Vectors);
procedure Delete
(Container : in out Vector;
Index : Extended_Index; -- TODO: verify
Index : Extended_Index;
Count : Count_Type := 1);
procedure Delete
......@@ -234,7 +234,15 @@ pragma Preelaborate (Vectors);
generic
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
(Container : Vector;
......@@ -301,6 +309,8 @@ private
type Vector is new Controlled with record
Elements : Elements_Access;
Last : Extended_Index := No_Index;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
procedure Adjust (Container : in out Vector);
......@@ -321,7 +331,7 @@ private
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;
for Vector_Access'Storage_Size use 0;
......
gcc/ada/a-coorma.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -93,34 +93,34 @@ pragma Preelaborate (Ordered_Maps);
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
Position : out Cursor;
Inserted : out Boolean);
procedure Include
procedure Insert
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Replace
procedure Include
(Container : in out Map;
Key : Key_Type;
New_Item : Element_Type);
procedure Insert
procedure Replace
(Container : in out Map;
Key : Key_Type;
Position : out Cursor;
Inserted : out Boolean);
New_Item : Element_Type);
procedure Delete (Container : in out Map; Key : Key_Type);
procedure Exclude (Container : in out Map; Key : Key_Type);
procedure Delete (Container : in out Map; Position : in out Cursor);
procedure Delete_First (Container : in out Map);
procedure Delete_Last (Container : in out Map);
procedure Exclude (Container : in out Map; Key : Key_Type);
function Contains (Container : Map; Key : Key_Type) return Boolean;
function Find (Container : Map; Key : Key_Type) return Cursor;
......@@ -145,10 +145,10 @@ pragma Preelaborate (Ordered_Maps);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -178,21 +178,32 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Node_Type is limited record
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;
use Ada.Finalization;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Map is new Controlled with record
Tree : Tree_Type := (Length => 0, others => null);
type Map is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Map);
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;
type Cursor is record
......@@ -210,7 +221,6 @@ private
for Map'Write use Write;
procedure Read
(Stream : access Root_Stream_Type'Class;
Container : out Map);
......@@ -218,6 +228,11 @@ private
for Map'Read use Read;
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;
gcc/ada/a-coormu.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -56,6 +56,8 @@ pragma Preelaborate (Ordered_Multisets);
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
function Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean;
......@@ -68,6 +70,11 @@ pragma Preelaborate (Ordered_Multisets);
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
procedure Replace_Element
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move
(Target : in out Set;
Source : in out Set);
......@@ -85,10 +92,6 @@ pragma Preelaborate (Ordered_Multisets);
(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);
......@@ -97,13 +100,9 @@ pragma Preelaborate (Ordered_Multisets);
procedure Delete_Last (Container : in out Set);
-- 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 Exclude
(Container : in out Set;
Item : Element_Type);
procedure Union (Target : in out Set; Source : Set);
......@@ -151,10 +150,10 @@ pragma Preelaborate (Ordered_Multisets);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -214,12 +213,6 @@ pragma Preelaborate (Ordered_Multisets);
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 Exclude (Container : in out Set; Key : Key_Type);
......@@ -232,9 +225,7 @@ pragma Preelaborate (Ordered_Multisets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- Should name of following be "Update_Element" ???
procedure Checked_Update_Element
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
......@@ -257,21 +248,31 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Node_Type is limited record
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;
use Ada.Finalization;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Set is new Controlled with record
Tree : Tree_Type := (Length => 0, others => null);
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Set);
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
......@@ -296,6 +297,11 @@ private
for Set'Read use Read;
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;
gcc/ada/a-coorse.ads
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -57,6 +57,8 @@ pragma Preelaborate (Ordered_Sets);
function "=" (Left, Right : Set) return Boolean;
function Equivalent_Sets (Left, Right : Set) return Boolean;
function Length (Container : Set) return Count_Type;
function Is_Empty (Container : Set) return Boolean;
......@@ -69,11 +71,10 @@ pragma Preelaborate (Ordered_Sets);
(Position : Cursor;
Process : not null access procedure (Element : Element_Type));
-- TODO: resolve in Atlanta. ???
-- procedure Replace_Element
-- (Container : in out Set;
-- Position : Cursor;
-- By : Element_Type);
procedure Replace_Element
(Container : Set; -- TODO: need ARG ruling
Position : Cursor;
By : Element_Type);
procedure Move
(Target : in out Set;
......@@ -94,17 +95,13 @@ pragma Preelaborate (Ordered_Sets);
New_Item : Element_Type);
procedure Replace
(Container : in out Set;
(Container : in out Set; -- TODO: need ARG ruling
New_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);
......@@ -113,6 +110,10 @@ pragma Preelaborate (Ordered_Sets);
procedure Delete_Last (Container : in out Set);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Union (Target : in out Set; Source : Set);
function Union (Left, Right : Set) return Set;
......@@ -160,10 +161,10 @@ pragma Preelaborate (Ordered_Sets);
function Next (Position : Cursor) return Cursor;
function Previous (Position : Cursor) return Cursor;
procedure Next (Position : in out Cursor);
function Previous (Position : Cursor) return Cursor;
procedure Previous (Position : in out Cursor);
function Has_Element (Position : Cursor) return Boolean;
......@@ -215,11 +216,10 @@ pragma Preelaborate (Ordered_Sets);
function Element (Container : Set; Key : Key_Type) return Element_Type;
-- TODO: resolve in Atlanta ???
-- procedure Replace
-- (Container : in out Set;
-- Key : Key_Type;
-- New_Item : Element_Type);
procedure Replace
(Container : in out Set; -- TODO: need ARG ruling
Key : Key_Type;
New_Item : Element_Type);
procedure Delete (Container : in out Set; Key : Key_Type);
......@@ -233,8 +233,7 @@ pragma Preelaborate (Ordered_Sets);
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
-- TODO: resolve name in Atlanta. Should name be just "Update_Element" ???
procedure Checked_Update_Element
procedure Update_Element_Preserving_Key
(Container : in out Set;
Position : Cursor;
Process : not null access
......@@ -247,21 +246,32 @@ private
type Node_Type;
type Node_Access is access Node_Type;
package Tree_Types is
new Red_Black_Trees.Generic_Tree_Types (Node_Access);
type Node_Type is limited record
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;
use Ada.Finalization;
package Tree_Types is new Red_Black_Trees.Generic_Tree_Types
(Node_Type,
Node_Access);
type Set is new Controlled with record
Tree : Tree_Type := (Length => 0, others => null);
type Set is new Ada.Finalization.Controlled with record
Tree : Tree_Types.Tree_Type;
end record;
procedure Adjust (Container : in out Set);
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
Container : Set_Access;
......@@ -285,6 +295,11 @@ private
for Set'Read use Read;
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;
gcc/ada/a-crbltr.ads
......@@ -2,15 +2,35 @@
-- --
-- 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 --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- 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. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- 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
......@@ -19,13 +39,17 @@ pragma Pure (Red_Black_Trees);
type Color_Type is (Red, Black);
generic
type Node_Access is private;
type Node_Type (<>) is limited private;
type Node_Access is access Node_Type;
package Generic_Tree_Types is
type Tree_Type is record
type Tree_Type is tagged record
First : Node_Access;
Last : Node_Access;
Root : Node_Access;
Length : Count_Type;
Length : Count_Type := 0;
Busy : Natural := 0;
Lock : Natural := 0;
end record;
end Generic_Tree_Types;
end Ada.Containers.Red_Black_Trees;
gcc/ada/a-crbtgk.ads
......@@ -2,7 +2,8 @@
-- --
-- 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 --
-- --
......@@ -133,6 +134,3 @@ pragma Pure (Generic_Keys);
Key : Key_Type);
end Ada.Containers.Red_Black_Trees.Generic_Keys;
gcc/ada/a-crbtgo.ads
......@@ -2,23 +2,44 @@
-- --
-- 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 --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- 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. --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- 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
with package Tree_Types is new Generic_Tree_Types (<>);
use Tree_Types;
Null_Node : Node_Access;
with function Parent (Node : Node_Access) return Node_Access is <>;
with procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is <>;
with function Left (Node : Node_Access) return Node_Access is <>;
......@@ -41,8 +62,6 @@ pragma Pure;
function Previous (Node : Node_Access) return Node_Access;
procedure Move (Target, Source : in out Tree_Type);
generic
with function Is_Equal (L, R : Node_Access) return Boolean;
function Generic_Equal (Left, Right : Tree_Type) return Boolean;
......@@ -52,6 +71,27 @@ pragma Pure;
Node : Node_Access);
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 <>;
procedure Generic_Iteration (Tree : Tree_Type);
......@@ -60,8 +100,20 @@ pragma Pure;
procedure Generic_Reverse_Iteration (Tree : Tree_Type);
generic
with function New_Node return Node_Access is <>;
procedure Generic_Read (Tree : in out Tree_Type; N : Count_Type);
with procedure Write_Node
(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
(Tree : in out Tree_Type;
......
gcc/ada/a-shcain.adb
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -52,17 +52,8 @@ is
begin
Tmp := 0;
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;
return Tmp;
end Ada.Strings.Hash_Case_Insensitive;
gcc/ada/a-shcain.ads
......@@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
......
gcc/ada/a-strhas.adb
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- 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
begin
Tmp := 0;
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;
return Tmp;
end Ada.Strings.Hash;
gcc/ada/a-stunha.adb
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -50,7 +50,7 @@ is
begin
Tmp := 0;
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;
return Tmp;
......
gcc/ada/a-stwiha.adb
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -50,10 +50,8 @@ is
begin
Tmp := 0;
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;
return Tmp;
end Ada.Strings.Wide_Hash;
gcc/ada/a-stwiha.ads
......@@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
......@@ -19,6 +19,3 @@ function Ada.Strings.Wide_Hash
(Key : Wide_String) return Containers.Hash_Type;
pragma Pure (Ada.Strings.Wide_Hash);
gcc/ada/a-stzhas.adb
......@@ -50,10 +50,8 @@ is
begin
Tmp := 0;
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;
return Tmp;
end Ada.Strings.Wide_Wide_Hash;
gcc/ada/a-swunha.adb → gcc/ada/a-swuwha.adb
......@@ -2,11 +2,11 @@
-- --
-- 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 --
-- --
-- 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 --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -35,7 +35,7 @@
-- 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
is
use Ada.Containers;
......@@ -50,8 +50,8 @@ is
begin
Tmp := 0;
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;
return Tmp;
end Ada.Strings.Wide_Unbounded.Hash;
end Ada.Strings.Wide_Unbounded.Wide_Hash;
gcc/ada/a-swunha.ads → gcc/ada/a-swuwha.ads
......@@ -2,10 +2,12 @@
-- --
-- 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 --
-- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
......@@ -15,7 +17,7 @@
with Ada.Containers;
function Ada.Strings.Wide_Unbounded.Hash
function Ada.Strings.Wide_Unbounded.Wide_Hash
(Key : Unbounded_Wide_String) return Containers.Hash_Type;
pragma Preelaborate (Ada.Strings.Wide_Unbounded.Hash);
pragma Preelaborate (Ada.Strings.Wide_Unbounded.Wide_Hash);
gcc/ada/a-szunha.adb → gcc/ada/a-szuzha.adb
......@@ -2,7 +2,7 @@
-- --
-- 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 --
-- --
......@@ -35,7 +35,7 @@
-- 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
is
use Ada.Containers;
......@@ -50,9 +50,9 @@ is
begin
Tmp := 0;
for J in 1 .. Key.Last loop
Tmp := Rotate_Left (Tmp, 1) +
Tmp := Rotate_Left (Tmp, 3) +
Wide_Wide_Character'Pos (Key.Reference (J));
end loop;
return Tmp;
end Ada.Strings.Wide_Wide_Unbounded.Hash;
end Ada.Strings.Wide_Wide_Unbounded.Wide_Wide_Hash;
gcc/ada/a-szunha.ads → gcc/ada/a-szuzha.ads
......@@ -2,10 +2,12 @@
-- --
-- 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 --
-- --
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
......@@ -15,7 +17,7 @@
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;
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