Skip to content

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

a-cihase.adb, [...]: Synchronized with latest draft (Draft 13, August 2005) of Ada Amendment 1. 

2005-09-01  Matthew Heaney  <heaney@adacore.com>

	* a-cihase.adb, a-coorse.ads, a-coorse.adb, a-cohama.adb,
	a-ciorse.ads, a-ciorse.adb, a-cihama.adb, a-cdlili.adb,
	a-cidlli.adb, a-chtgop.adb, a-cihase.adb, a-cihase.ads,
	a-cohase.adb, a-cohase.adb, a-cohase.ads: Synchronized with latest
	draft (Draft 13, August 2005) of Ada Amendment 1.

From-SVN: r103892
parent c1cd0d96
Showing with 378 additions and 368 deletions
gcc/ada/a-cihase.ads
...@@ -49,8 +49,7 @@ generic ...@@ -49,8 +49,7 @@ generic
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Indefinite_Hashed_Sets is package Ada.Containers.Indefinite_Hashed_Sets is
pragma Preelaborate;
pragma Preelaborate (Indefinite_Hashed_Sets);
type Set is tagged private; type Set is tagged private;
...@@ -64,6 +63,12 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -64,6 +63,12 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Equivalent_Sets (Left, Right : Set) return Boolean; function Equivalent_Sets (Left, Right : Set) return Boolean;
function Capacity (Container : Set) return Count_Type;
procedure Reserve_Capacity
(Container : in out Set;
Capacity : Count_Type);
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;
...@@ -72,15 +77,15 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -72,15 +77,15 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Replace_Element
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move procedure Move
(Target : in out Set; (Target : in out Set;
Source : in out Set); Source : in out Set);
...@@ -97,37 +102,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -97,37 +102,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is
procedure Replace (Container : in out Set; New_Item : Element_Type); procedure Replace (Container : in out Set; New_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);
function Contains (Container : Set; Item : Element_Type) return Boolean; procedure Delete (Container : in out Set; Item : Element_Type);
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 procedure Delete (Container : in out Set; Position : in out Cursor);
(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);
...@@ -158,41 +137,59 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -158,41 +137,59 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Is_Subset (Subset : Set; Of_Set : Set) return Boolean; function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
function Capacity (Container : Set) return Count_Type; function First (Container : Set) return Cursor;
procedure Reserve_Capacity function Next (Position : Cursor) return Cursor;
(Container : in out Set;
Capacity : Count_Type); procedure Next (Position : in out Cursor);
function Find (Container : Set; Item : Element_Type) return Cursor;
function Contains (Container : Set; Item : Element_Type) return Boolean;
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));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function Hash (Key : Key_Type) return Hash_Type; with function Hash (Key : Key_Type) return Hash_Type;
with function Equivalent_Keys with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
(Key : Key_Type;
Element : Element_Type) return Boolean;
package Generic_Keys is package Generic_Keys is
function Contains (Container : Set; Key : Key_Type) return Boolean;
function Find (Container : Set; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
procedure Replace procedure Replace -- TODO: ask Randy why this is still here
(Container : in out Set; (Container : in out Set;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Exclude (Container : in out Set; Key : Key_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); function Find (Container : Set; Key : Key_Type) return Cursor;
function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
...@@ -200,13 +197,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -200,13 +197,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is
Process : not null access Process : not null access
procedure (Element : in out Element_Type)); procedure (Element : in out Element_Type));
function Equivalent_Keys
(Left : Cursor;
Right : Key_Type) return Boolean;
function Equivalent_Keys
(Left : Key_Type;
Right : Cursor) return Boolean;
end Generic_Keys; end Generic_Keys;
private private
......
gcc/ada/a-ciorse.adb
...@@ -369,6 +369,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -369,6 +369,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
return Position.Node.Element.all; return Position.Node.Element.all;
end Element; end Element;
-------------------------
-- Equivalent_Elements --
-------------------------
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
begin
if Left < Right
or else Right < Left
then
return False;
else
return True;
end if;
end Equivalent_Elements;
--------------------- ---------------------
-- Equivalent_Sets -- -- Equivalent_Sets --
--------------------- ---------------------
...@@ -528,34 +543,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -528,34 +543,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
Is_Less_Key_Node => Is_Less_Key_Node, Is_Less_Key_Node => Is_Less_Key_Node,
Is_Greater_Key_Node => Is_Greater_Key_Node); Is_Greater_Key_Node => Is_Greater_Key_Node);
---------
-- "<" --
---------
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Left < Right.Node.Element.all;
end "<";
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Right > Left.Node.Element.all;
end "<";
---------
-- ">" --
---------
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Left > Right.Node.Element.all;
end ">";
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Right < Left.Node.Element.all;
end ">";
------------- -------------
-- Ceiling -- -- Ceiling --
------------- -------------
...@@ -609,6 +596,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -609,6 +596,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
return Node.Element.all; return Node.Element.all;
end Element; end Element;
---------------------
-- Equivalent_Keys --
---------------------
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
if Left < Right
or else Right < Left
then
return False;
else
return True;
end if;
end Equivalent_Keys;
------------- -------------
-- Exclude -- -- Exclude --
------------- -------------
...@@ -663,7 +665,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -663,7 +665,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
(Left : Key_Type; (Left : Key_Type;
Right : Node_Access) return Boolean is Right : Node_Access) return Boolean is
begin begin
return Left > Right.Element.all; return Key (Right.Element.all) < Left;
end Is_Greater_Key_Node; end Is_Greater_Key_Node;
---------------------- ----------------------
...@@ -674,7 +676,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -674,7 +676,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
(Left : Key_Type; (Left : Key_Type;
Right : Node_Access) return Boolean is Right : Node_Access) return Boolean is
begin begin
return Left < Right.Element.all; return Left < Key (Right.Element.all);
end Is_Less_Key_Node; end Is_Less_Key_Node;
--------- ---------
...@@ -728,7 +730,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -728,7 +730,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
declare declare
E : Element_Type renames Position.Node.Element.all; E : Element_Type renames Position.Node.Element.all;
K : Key_Type renames Key (E); K : constant Key_Type := Key (E);
B : Natural renames Tree.Busy; B : Natural renames Tree.Busy;
L : Natural renames Tree.Lock; L : Natural renames Tree.Lock;
...@@ -749,11 +751,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -749,11 +751,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
if K < E if Equivalent_Keys (K, Key (E)) then
or else K > E
then
null;
else
return; return;
end if; end if;
end; end;
...@@ -1365,12 +1363,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -1365,12 +1363,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
end Replace_Element; end Replace_Element;
procedure Replace_Element procedure Replace_Element
(Container : Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
By : Element_Type) New_Item : Element_Type)
is is
Tree : Tree_Type renames Position.Container.Tree'Unrestricted_Access.all;
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error;
...@@ -1380,7 +1376,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -1380,7 +1376,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
raise Program_Error; raise Program_Error;
end if; end if;
Replace_Element (Tree, Position.Node, By); Replace_Element (Container.Tree, Position.Node, New_Item);
end Replace_Element; end Replace_Element;
--------------------- ---------------------
......
gcc/ada/a-ciorse.ads
...@@ -45,7 +45,9 @@ generic ...@@ -45,7 +45,9 @@ generic
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Indefinite_Ordered_Sets is package Ada.Containers.Indefinite_Ordered_Sets is
pragma Preelaborate (Indefinite_Ordered_Sets); pragma Preelaborate;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
type Set is tagged private; type Set is tagged private;
...@@ -67,15 +69,15 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -67,15 +69,15 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Replace_Element
(Container : Set; -- TODO: need ruling from ARG
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
...@@ -96,6 +98,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -96,6 +98,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Container : in out Set; (Container : in out Set;
New_Item : Element_Type); New_Item : Element_Type);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
...@@ -108,10 +114,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -108,10 +114,6 @@ 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;
...@@ -124,8 +126,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -124,8 +126,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
function "and" (Left, Right : Set) return Set renames Intersection; function "and" (Left, Right : Set) return Set renames Intersection;
procedure Difference (Target : in out Set; procedure Difference (Target : in out Set; Source : Set);
Source : Set);
function Difference (Left, Right : Set) return Set; function Difference (Left, Right : Set) return Set;
...@@ -141,14 +142,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -141,14 +142,6 @@ pragma Preelaborate (Indefinite_Ordered_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 Floor (Container : Set; Item : Element_Type) return Cursor;
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
function First (Container : Set) return Cursor; function First (Container : Set) return Cursor;
function First_Element (Container : Set) return Element_Type; function First_Element (Container : Set) return Element_Type;
...@@ -165,6 +158,14 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -165,6 +158,14 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Find (Container : Set; Item : Element_Type) return Cursor;
function Floor (Container : Set; Item : Element_Type) return Cursor;
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
function Contains (Container : Set; Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -188,21 +189,28 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -188,21 +189,28 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function "<" (Left : Key_Type; Right : Element_Type) with function "<" (Left, Right : Key_Type) return Boolean is <>;
return Boolean is <>;
with function ">" (Left : Key_Type; Right : Element_Type)
return Boolean is <>;
package Generic_Keys is package Generic_Keys is
function Contains function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
(Container : Set;
Key : Key_Type) return Boolean; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_Type;
procedure Replace
(Container : in out Set;
Key : Key_Type;
New_Item : Element_Type);
procedure Exclude (Container : in out Set; Key : Key_Type);
procedure Delete (Container : in out Set; Key : Key_Type);
function Find function Find
(Container : Set; (Container : Set;
...@@ -216,28 +224,9 @@ pragma Preelaborate (Indefinite_Ordered_Sets); ...@@ -216,28 +224,9 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
(Container : Set; (Container : Set;
Key : Key_Type) return Cursor; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Contains
function Element
(Container : Set; (Container : Set;
Key : Key_Type) return Element_Type; Key : Key_Type) return Boolean;
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);
procedure Exclude (Container : in out Set; Key : Key_Type);
function "<" (Left : Cursor; Right : Key_Type) return Boolean;
function ">" (Left : Cursor; Right : Key_Type) return Boolean;
function "<" (Left : Key_Type; Right : Cursor) return Boolean;
function ">" (Left : Key_Type; Right : Cursor) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
......
gcc/ada/a-cohase.ads
...@@ -48,7 +48,7 @@ generic ...@@ -48,7 +48,7 @@ generic
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Hashed_Sets is package Ada.Containers.Hashed_Sets is
pragma Preelaborate (Hashed_Sets); pragma Preelaborate;
type Set is tagged private; type Set is tagged private;
...@@ -62,6 +62,12 @@ pragma Preelaborate (Hashed_Sets); ...@@ -62,6 +62,12 @@ pragma Preelaborate (Hashed_Sets);
function Equivalent_Sets (Left, Right : Set) return Boolean; function Equivalent_Sets (Left, Right : Set) return Boolean;
function Capacity (Container : Set) return Count_Type;
procedure Reserve_Capacity
(Container : in out Set;
Capacity : Count_Type);
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;
...@@ -70,15 +76,15 @@ pragma Preelaborate (Hashed_Sets); ...@@ -70,15 +76,15 @@ pragma Preelaborate (Hashed_Sets);
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Replace_Element
(Container : Set;
Position : Cursor;
By : Element_Type);
procedure Move (Target : in out Set; Source : in out Set); procedure Move (Target : in out Set; Source : in out Set);
procedure Insert procedure Insert
...@@ -93,39 +99,11 @@ pragma Preelaborate (Hashed_Sets); ...@@ -93,39 +99,11 @@ pragma Preelaborate (Hashed_Sets);
procedure Replace (Container : in out Set; New_Item : Element_Type); procedure Replace (Container : in out Set; New_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);
function Contains (Container : Set; Item : Element_Type) return Boolean; procedure Delete (Container : in out Set; Item : Element_Type);
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 procedure Delete (Container : in out Set; Position : in out Cursor);
(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);
...@@ -156,41 +134,61 @@ pragma Preelaborate (Hashed_Sets); ...@@ -156,41 +134,61 @@ 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 Capacity (Container : Set) return Count_Type; function First (Container : Set) return Cursor;
procedure Reserve_Capacity function Next (Position : Cursor) return Cursor;
(Container : in out Set;
Capacity : Count_Type); procedure Next (Position : in out Cursor);
function Find
(Container : Set;
Item : Element_Type) return Cursor;
function Contains (Container : Set; Item : Element_Type) return Boolean;
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));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function Hash (Key : Key_Type) return Hash_Type; with function Hash (Key : Key_Type) return Hash_Type;
with function Equivalent_Keys with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
(Key : Key_Type;
Element : Element_Type) return Boolean;
package Generic_Keys is package Generic_Keys is
function Contains (Container : Set; Key : Key_Type) return Boolean;
function Find (Container : Set; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
procedure Replace procedure Replace -- TODO: ask Randy why this wasn't removed
(Container : in out Set; (Container : in out Set;
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type); New_Item : Element_Type);
procedure Exclude (Container : in out Set; Key : Key_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); function Find (Container : Set; Key : Key_Type) return Cursor;
function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
...@@ -198,18 +196,9 @@ pragma Preelaborate (Hashed_Sets); ...@@ -198,18 +196,9 @@ pragma Preelaborate (Hashed_Sets);
Process : not null access Process : not null access
procedure (Element : in out Element_Type)); procedure (Element : in out Element_Type));
function Equivalent_Keys
(Left : Cursor;
Right : Key_Type) return Boolean;
function Equivalent_Keys
(Left : Key_Type;
Right : Cursor) return Boolean;
end Generic_Keys; end Generic_Keys;
private private
type Node_Type; type Node_Type;
type Node_Access is access Node_Type; type Node_Access is access Node_Type;
......
gcc/ada/a-coorse.adb
...@@ -359,6 +359,21 @@ package body Ada.Containers.Ordered_Sets is ...@@ -359,6 +359,21 @@ package body Ada.Containers.Ordered_Sets is
return Position.Node.Element; return Position.Node.Element;
end Element; end Element;
-------------------------
-- Equivalent_Elements --
-------------------------
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
begin
if Left < Right
or else Right < Left
then
return False;
else
return True;
end if;
end Equivalent_Elements;
--------------------- ---------------------
-- Equivalent_Sets -- -- Equivalent_Sets --
--------------------- ---------------------
...@@ -490,34 +505,6 @@ package body Ada.Containers.Ordered_Sets is ...@@ -490,34 +505,6 @@ package body Ada.Containers.Ordered_Sets is
Is_Less_Key_Node => Is_Less_Key_Node, Is_Less_Key_Node => Is_Less_Key_Node,
Is_Greater_Key_Node => Is_Greater_Key_Node); Is_Greater_Key_Node => Is_Greater_Key_Node);
---------
-- "<" --
---------
function "<" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Left < Right.Node.Element;
end "<";
function "<" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Right > Left.Node.Element;
end "<";
---------
-- ">" --
---------
function ">" (Left : Key_Type; Right : Cursor) return Boolean is
begin
return Left > Right.Node.Element;
end ">";
function ">" (Left : Cursor; Right : Key_Type) return Boolean is
begin
return Right < Left.Node.Element;
end ">";
------------- -------------
-- Ceiling -- -- Ceiling --
------------- -------------
...@@ -573,6 +560,21 @@ package body Ada.Containers.Ordered_Sets is ...@@ -573,6 +560,21 @@ package body Ada.Containers.Ordered_Sets is
return Node.Element; return Node.Element;
end Element; end Element;
---------------------
-- Equivalent_Keys --
---------------------
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
if Left < Right
or else Right < Left
then
return False;
else
return True;
end if;
end Equivalent_Keys;
------------- -------------
-- Exclude -- -- Exclude --
------------- -------------
...@@ -626,7 +628,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -626,7 +628,7 @@ package body Ada.Containers.Ordered_Sets is
Right : Node_Access) return Boolean Right : Node_Access) return Boolean
is is
begin begin
return Left > Right.Element; return Key (Right.Element) < Left;
end Is_Greater_Key_Node; end Is_Greater_Key_Node;
---------------------- ----------------------
...@@ -638,7 +640,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -638,7 +640,7 @@ package body Ada.Containers.Ordered_Sets is
Right : Node_Access) return Boolean Right : Node_Access) return Boolean
is is
begin begin
return Left < Right.Element; return Left < Key (Right.Element);
end Is_Less_Key_Node; end Is_Less_Key_Node;
--------- ---------
...@@ -691,7 +693,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -691,7 +693,7 @@ package body Ada.Containers.Ordered_Sets is
declare declare
E : Element_Type renames Position.Node.Element; E : Element_Type renames Position.Node.Element;
K : Key_Type renames Key (E); K : constant Key_Type := Key (E);
B : Natural renames Tree.Busy; B : Natural renames Tree.Busy;
L : Natural renames Tree.Lock; L : Natural renames Tree.Lock;
...@@ -712,11 +714,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -712,11 +714,7 @@ package body Ada.Containers.Ordered_Sets is
L := L - 1; L := L - 1;
B := B - 1; B := B - 1;
if K < E if Equivalent_Keys (K, Key (E)) then
or else K > E
then
null;
else
return; return;
end if; end if;
end; end;
...@@ -1319,12 +1317,10 @@ package body Ada.Containers.Ordered_Sets is ...@@ -1319,12 +1317,10 @@ package body Ada.Containers.Ordered_Sets is
end Replace_Element; end Replace_Element;
procedure Replace_Element procedure Replace_Element
(Container : Set; (Container : in out Set;
Position : Cursor; Position : Cursor;
By : Element_Type) New_Item : Element_Type)
is is
Tree : Tree_Type renames Container.Tree'Unrestricted_Access.all;
begin begin
if Position.Node = null then if Position.Node = null then
raise Constraint_Error; raise Constraint_Error;
...@@ -1334,7 +1330,7 @@ package body Ada.Containers.Ordered_Sets is ...@@ -1334,7 +1330,7 @@ package body Ada.Containers.Ordered_Sets is
raise Program_Error; raise Program_Error;
end if; end if;
Replace_Element (Tree, Position.Node, By); Replace_Element (Container.Tree, Position.Node, New_Item);
end Replace_Element; end Replace_Element;
--------------------- ---------------------
......
gcc/ada/a-coorse.ads
...@@ -38,14 +38,15 @@ with Ada.Finalization; ...@@ -38,14 +38,15 @@ with Ada.Finalization;
with Ada.Streams; with Ada.Streams;
generic generic
type Element_Type is private; type Element_Type is private;
with function "<" (Left, Right : Element_Type) return Boolean is <>; with function "<" (Left, Right : Element_Type) return Boolean is <>;
with function "=" (Left, Right : Element_Type) return Boolean is <>; with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Ada.Containers.Ordered_Sets is package Ada.Containers.Ordered_Sets is
pragma Preelaborate (Ordered_Sets); pragma Preelaborate;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
type Set is tagged private; type Set is tagged private;
...@@ -67,18 +68,16 @@ pragma Preelaborate (Ordered_Sets); ...@@ -67,18 +68,16 @@ pragma Preelaborate (Ordered_Sets);
function Element (Position : Cursor) return Element_Type; function Element (Position : Cursor) return Element_Type;
procedure Replace_Element
(Container : in out Set;
Position : Cursor;
New_Item : Element_Type);
procedure Query_Element procedure Query_Element
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Element : Element_Type)); Process : not null access procedure (Element : Element_Type));
procedure Replace_Element procedure Move (Target : in out Set; Source : in out Set);
(Container : Set; -- TODO: need ARG ruling
Position : Cursor;
By : Element_Type);
procedure Move
(Target : in out Set;
Source : in out Set);
procedure Insert procedure Insert
(Container : in out Set; (Container : in out Set;
...@@ -95,9 +94,13 @@ pragma Preelaborate (Ordered_Sets); ...@@ -95,9 +94,13 @@ pragma Preelaborate (Ordered_Sets);
New_Item : Element_Type); New_Item : Element_Type);
procedure Replace procedure Replace
(Container : in out Set; -- TODO: need ARG ruling (Container : in out Set;
New_Item : Element_Type); New_Item : Element_Type);
procedure Exclude
(Container : in out Set;
Item : Element_Type);
procedure Delete procedure Delete
(Container : in out Set; (Container : in out Set;
Item : Element_Type); Item : Element_Type);
...@@ -110,10 +113,6 @@ pragma Preelaborate (Ordered_Sets); ...@@ -110,10 +113,6 @@ 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;
...@@ -126,8 +125,7 @@ pragma Preelaborate (Ordered_Sets); ...@@ -126,8 +125,7 @@ pragma Preelaborate (Ordered_Sets);
function "and" (Left, Right : Set) return Set renames Intersection; function "and" (Left, Right : Set) return Set renames Intersection;
procedure Difference (Target : in out Set; procedure Difference (Target : in out Set; Source : Set);
Source : Set);
function Difference (Left, Right : Set) return Set; function Difference (Left, Right : Set) return Set;
...@@ -143,14 +141,6 @@ pragma Preelaborate (Ordered_Sets); ...@@ -143,14 +141,6 @@ pragma Preelaborate (Ordered_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 Floor (Container : Set; Item : Element_Type) return Cursor;
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
function First (Container : Set) return Cursor; function First (Container : Set) return Cursor;
function First_Element (Container : Set) return Element_Type; function First_Element (Container : Set) return Element_Type;
...@@ -167,6 +157,14 @@ pragma Preelaborate (Ordered_Sets); ...@@ -167,6 +157,14 @@ pragma Preelaborate (Ordered_Sets);
procedure Previous (Position : in out Cursor); procedure Previous (Position : in out Cursor);
function Find (Container : Set; Item : Element_Type) return Cursor;
function Floor (Container : Set; Item : Element_Type) return Cursor;
function Ceiling (Container : Set; Item : Element_Type) return Cursor;
function Contains (Container : Set; Item : Element_Type) return Boolean;
function Has_Element (Position : Cursor) return Boolean; function Has_Element (Position : Cursor) return Boolean;
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
...@@ -190,48 +188,36 @@ pragma Preelaborate (Ordered_Sets); ...@@ -190,48 +188,36 @@ pragma Preelaborate (Ordered_Sets);
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
generic generic
type Key_Type (<>) is limited private; type Key_Type (<>) is private;
with function Key (Element : Element_Type) return Key_Type; with function Key (Element : Element_Type) return Key_Type;
with function "<" with function "<" (Left, Right : Key_Type) return Boolean is <>;
(Left : Key_Type;
Right : Element_Type) return Boolean is <>;
with function ">"
(Left : Key_Type;
Right : Element_Type) return Boolean is <>;
package Generic_Keys is package Generic_Keys is
function Contains (Container : Set; Key : Key_Type) return Boolean; function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
function Find (Container : Set; Key : Key_Type) return Cursor;
function Floor (Container : Set; Key : Key_Type) return Cursor;
function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function Key (Position : Cursor) return Key_Type; function Key (Position : Cursor) return Key_Type;
function Element (Container : Set; Key : Key_Type) return Element_Type; function Element (Container : Set; Key : Key_Type) return Element_Type;
procedure 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 Exclude (Container : in out Set; Key : Key_Type); procedure Exclude (Container : in out Set; Key : Key_Type);
function "<" (Left : Cursor; Right : Key_Type) return Boolean; procedure Delete (Container : in out Set; Key : Key_Type);
function Find (Container : Set; Key : Key_Type) return Cursor;
function ">" (Left : Cursor; Right : Key_Type) return Boolean; function Floor (Container : Set; Key : Key_Type) return Cursor;
function "<" (Left : Key_Type; Right : Cursor) return Boolean; function Ceiling (Container : Set; Key : Key_Type) return Cursor;
function ">" (Left : Key_Type; Right : Cursor) return Boolean; function Contains (Container : Set; Key : Key_Type) return Boolean;
procedure Update_Element_Preserving_Key procedure Update_Element_Preserving_Key
(Container : in out Set; (Container : in out Set;
......
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