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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@101069 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 1207 insertions, 879 deletions

diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb
index cc5589f0c1c..f47d9a6c157 100644
--- a/gcc/ada/a-cihase.adb
+++ b/gcc/ada/a-cihase.adb
@@ -2,11 +2,12 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---                  ADA.CONTAINERS.INDEFINITE_HASHED_SETS                   --
+--                      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 _ S E T 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 --
@@ -45,849 +46,1184 @@ with System;  use type System.Address;
 
 with Ada.Containers.Prime_Numbers;
 
-with Ada.Finalization;  use Ada.Finalization;
-
 package body Ada.Containers.Indefinite_Hashed_Sets is
 
-   type Element_Access is access Element_Type;
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
 
-   type Node_Type is
-      limited record
-         Element : Element_Access;
-         Next    : Node_Access;
-      end record;
+   function Copy_Node (Source : Node_Access) return Node_Access;
+   pragma Inline (Copy_Node);
 
-   function Hash_Node
-     (Node : Node_Access) return Hash_Type;
-   pragma Inline (Hash_Node);
+   function Equivalent_Keys
+     (Key  : Element_Type;
+      Node : Node_Access) return Boolean;
+   pragma Inline (Equivalent_Keys);
 
-   function Hash_Node
-     (Node : Node_Access) return Hash_Type is
-   begin
-      return Hash (Node.Element.all);
-   end Hash_Node;
+   function Find_Equal_Key
+     (R_HT   : Hash_Table_Type;
+      L_Node : Node_Access) return Boolean;
 
-   function Next
-     (Node : Node_Access) return Node_Access;
-   pragma Inline (Next);
+   function Find_Equivalent_Key
+     (R_HT   : Hash_Table_Type;
+      L_Node : Node_Access) return Boolean;
 
-   function Next
-     (Node : Node_Access) return Node_Access is
-   begin
-      return Node.Next;
-   end Next;
+   procedure Free (X : in out Node_Access);
 
-   procedure Set_Next
-     (Node : Node_Access;
-      Next : Node_Access);
-   pragma Inline (Set_Next);
+   function Hash_Node (Node : Node_Access) return Hash_Type;
+   pragma Inline (Hash_Node);
 
-   procedure Set_Next
-     (Node : Node_Access;
-      Next : Node_Access) is
-   begin
-      Node.Next := Next;
-   end Set_Next;
+   function Is_In (HT  : Hash_Table_Type; Key : Node_Access) return Boolean;
+   pragma Inline (Is_In);
 
-   function Equivalent_Keys
-     (Key  : Element_Type;
-      Node : Node_Access) return Boolean;
-   pragma Inline (Equivalent_Keys);
+   function Next (Node : Node_Access) return Node_Access;
+   pragma Inline (Next);
 
-   function Equivalent_Keys
-     (Key  : Element_Type;
-      Node : Node_Access) return Boolean is
-   begin
-      return Equivalent_Keys (Key, Node.Element.all);
-   end Equivalent_Keys;
+   function Read_Node (Stream : access Root_Stream_Type'Class)
+     return Node_Access;
+   pragma Inline (Read_Node);
 
-   function Copy_Node
-     (Source : Node_Access) return Node_Access;
-   pragma Inline (Copy_Node);
+   procedure Replace_Element
+     (HT      : in out Hash_Table_Type;
+      Node    : Node_Access;
+      Element : Element_Type);
 
-   function Copy_Node
-     (Source : Node_Access) return Node_Access is
+   procedure Set_Next (Node : Node_Access; Next : Node_Access);
+   pragma Inline (Set_Next);
 
-      Target : constant Node_Access :=
-        new Node_Type'(Element => Source.Element,
-                       Next    => null);
-   begin
-      return Target;
-   end Copy_Node;
+   procedure Write_Node
+     (Stream : access Root_Stream_Type'Class;
+      Node   : Node_Access);
+   pragma Inline (Write_Node);
 
+   --------------------------
+   -- Local Instantiations --
+   --------------------------
 
    procedure Free_Element is
       new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
 
-   procedure Free (X : in out Node_Access);
-
-   procedure Free (X : in out Node_Access) is
-      procedure Deallocate is
-         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-   begin
-      if X /= null then
-         Free_Element (X.Element);
-         Deallocate (X);
-      end if;
-   end Free;
-
    package HT_Ops is
       new Hash_Tables.Generic_Operations
-       (HT_Types          => HT_Types,
-        Hash_Table_Type   => Set,
-        Null_Node         => null,
-        Hash_Node         => Hash_Node,
-        Next              => Next,
-        Set_Next          => Set_Next,
-        Copy_Node         => Copy_Node,
-        Free              => Free);
+       (HT_Types  => HT_Types,
+        Hash_Node => Hash_Node,
+        Next      => Next,
+        Set_Next  => Set_Next,
+        Copy_Node => Copy_Node,
+        Free      => Free);
 
    package Element_Keys is
       new Hash_Tables.Generic_Keys
        (HT_Types  => HT_Types,
-        HT_Type   => Set,
-        Null_Node => null,
         Next      => Next,
         Set_Next  => Set_Next,
         Key_Type  => Element_Type,
         Hash      => Hash,
         Equivalent_Keys => Equivalent_Keys);
 
+   function Is_Equal is
+      new HT_Ops.Generic_Equal (Find_Equal_Key);
 
-   procedure Adjust (Container : in out Set) renames HT_Ops.Adjust;
-
-   procedure Finalize (Container : in out Set) renames HT_Ops.Finalize;
-
-
-   function Find_Equal_Key
-     (R_Set  : Set;
-      L_Node : Node_Access) return Boolean;
+   function Is_Equivalent is
+      new HT_Ops.Generic_Equal (Find_Equivalent_Key);
 
-   function Find_Equal_Key
-     (R_Set  : Set;
-      L_Node : Node_Access) return Boolean is
+   procedure Read_Nodes is
+      new HT_Ops.Generic_Read (Read_Node);
 
-      R_Index : constant Hash_Type :=
-        Element_Keys.Index (R_Set, L_Node.Element.all);
+   procedure Write_Nodes is
+     new HT_Ops.Generic_Write (Write_Node);
 
-      R_Node  : Node_Access := R_Set.Buckets (R_Index);
+   ---------
+   -- "=" --
+   ---------
 
+   function "=" (Left, Right : Set) return Boolean is
    begin
+      return Is_Equal (Left.HT, Right.HT);
+   end "=";
 
-      loop
-
-         if R_Node = null then
-            return False;
-         end if;
-
-         if L_Node.Element.all = R_Node.Element.all then
-            return True;
-         end if;
-
-         R_Node := Next (R_Node);
-
-      end loop;
-
-   end Find_Equal_Key;
-
-   function Is_Equal is
-      new HT_Ops.Generic_Equal (Find_Equal_Key);
+   ------------
+   -- Adjust --
+   ------------
 
-   function "=" (Left, Right : Set) return Boolean renames Is_Equal;
+   procedure Adjust (Container : in out Set) is
+   begin
+      HT_Ops.Adjust (Container.HT);
+   end Adjust;
 
+   --------------
+   -- Capacity --
+   --------------
 
-   function Length (Container : Set) return Count_Type is
+   function Capacity (Container : Set) return Count_Type is
    begin
-      return Container.Length;
-   end Length;
+      return HT_Ops.Capacity (Container.HT);
+   end Capacity;
 
+   -----------
+   -- Clear --
+   -----------
 
-   function Is_Empty (Container : Set) return Boolean is
+   procedure Clear (Container : in out Set) is
    begin
-      return Container.Length = 0;
-   end Is_Empty;
+      HT_Ops.Clear (Container.HT);
+   end Clear;
 
+   --------------
+   -- Contains --
+   --------------
 
-   procedure Clear (Container : in out Set) renames HT_Ops.Clear;
+   function Contains (Container : Set; Item : Element_Type) return Boolean is
+   begin
+      return Find (Container, Item) /= No_Element;
+   end Contains;
 
+   ---------------
+   -- Copy_Node --
+   ---------------
 
-   function Element (Position : Cursor) return Element_Type is
+   function Copy_Node (Source : Node_Access) return Node_Access is
+      E : Element_Access := new Element_Type'(Source.Element.all);
    begin
-      return Position.Node.Element.all;
-   end Element;
+      return new Node_Type'(Element => E, Next => null);
+   exception
+      when others =>
+         Free_Element (E);
+         raise;
+   end Copy_Node;
 
+   ------------
+   -- Delete --
+   ------------
 
-   procedure Query_Element
-     (Position : in Cursor;
-      Process  : not null access procedure (Element : in Element_Type)) is
-   begin
-      Process (Position.Node.Element.all);
-   end Query_Element;
+   procedure Delete
+     (Container : in out Set;
+      Item      : Element_Type)
+   is
+      X : Node_Access;
 
+   begin
+      Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
 
---  TODO:
---     procedure Replace_Element (Container : in out Set;
---                                Position  : in     Node_Access;
---                                By        : in     Element_Type);
+      if X = null then
+         raise Constraint_Error;
+      end if;
 
---     procedure Replace_Element (Container : in out Set;
---                                Position  : in     Node_Access;
---                                By        : in     Element_Type) is
+      Free (X);
+   end Delete;
 
---        Node : Node_Access := Position;
+   procedure Delete
+     (Container : in out Set;
+      Position  : in out Cursor)
+   is
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
---     begin
+      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
+         raise Program_Error;
+      end if;
 
---        if Equivalent_Keys (Node.Element.all, By) then
+      if Container.HT.Busy > 0 then
+         raise Program_Error;
+      end if;
 
---           declare
---              X : Element_Access := Node.Element;
---           begin
---              Node.Element := new Element_Type'(By);
---              --
---              --  NOTE: If there's an exception here, then just
---              --  let it propagate.  We haven't modified the
---              --  state of the container, so there's nothing else
---              --  we need to do.
+      HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
---              Free_Element (X);
---           end;
+      Free (Position.Node);
 
---           return;
+      Position.Container := null;
+   end Delete;
 
---        end if;
+   ----------------
+   -- Difference --
+   ----------------
 
---        HT_Ops.Delete_Node_Sans_Free (Container, Node);
+   procedure Difference
+     (Target : in out Set;
+      Source : Set)
+   is
+      Tgt_Node : Node_Access;
 
---        begin
---           Free_Element (Node.Element);
---        exception
---           when others =>
---              Node.Element := null;  --  don't attempt to dealloc X.E again
---              Free (Node);
---              raise;
---        end;
+   begin
+      if Target'Address = Source'Address then
+         Clear (Target);
+         return;
+      end if;
 
---        begin
---           Node.Element := new Element_Type'(By);
---        exception
---           when others =>
---              Free (Node);
---              raise;
---        end;
+      if Source.Length = 0 then
+         return;
+      end if;
 
---        declare
---           function New_Node (Next : Node_Access) return Node_Access;
---           pragma Inline (New_Node);
+      if Target.HT.Busy > 0 then
+         raise Program_Error;
+      end if;
 
---           function New_Node (Next : Node_Access) return Node_Access is
---           begin
---              Node.Next := Next;
---              return Node;
---           end New_Node;
+      --  TODO: This can be written in terms of a loop instead as
+      --  active-iterator style, sort of like a passive iterator.
 
---           procedure Insert is
---              new Element_Keys.Generic_Conditional_Insert (New_Node);
+      Tgt_Node := HT_Ops.First (Target.HT);
+      while Tgt_Node /= null loop
+         if Is_In (Source.HT, Tgt_Node) then
+            declare
+               X : Node_Access := Tgt_Node;
+            begin
+               Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
+               HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
+               Free (X);
+            end;
 
---           Result  : Node_Access;
---           Success : Boolean;
---        begin
---           Insert
---             (HT      => Container,
---              Key     => Node.Element.all,
---              Node    => Result,
---              Success => Success);
+         else
+            Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
+         end if;
+      end loop;
+   end Difference;
 
---           if not Success then
---              Free (Node);
---              raise Program_Error;
---           end if;
+   function Difference (Left, Right : Set) return Set is
+      Buckets : HT_Types.Buckets_Access;
+      Length  : Count_Type;
 
---           pragma Assert (Result = Node);
---        end;
+   begin
+      if Left'Address = Right'Address then
+         return Empty_Set;
+      end if;
 
---     end Replace_Element;
+      if Left.Length = 0 then
+         return Empty_Set;
+      end if;
 
+      if Right.Length = 0 then
+         return Left;
+      end if;
 
---     procedure Replace_Element (Container : in out Set;
---                                Position  : in     Cursor;
---                                By        : in     Element_Type) is
---     begin
+      declare
+         Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
+      begin
+         Buckets := new Buckets_Type (0 .. Size - 1);
+      end;
 
---        if Position.Container = null then
---           raise Constraint_Error;
---        end if;
+      Length := 0;
 
---        if Position.Container /= Set_Access'(Container'Unchecked_Access) then
---           raise Program_Error;
---        end if;
+      Iterate_Left : declare
+         procedure Process (L_Node : Node_Access);
 
---        Replace_Element (Container, Position.Node, By);
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
 
---     end Replace_Element;
+         -------------
+         -- Process --
+         -------------
 
+         procedure Process (L_Node : Node_Access) is
+         begin
+            if not Is_In (Right.HT, L_Node) then
+               declare
+                  Indx : constant Hash_Type :=
+                           Hash (L_Node.Element.all) mod Buckets'Length;
 
-   procedure Move (Target : in out Set;
-                   Source : in out Set) renames HT_Ops.Move;
+                  Bucket : Node_Access renames Buckets (Indx);
 
+               begin
+                  Bucket := new Node_Type'(L_Node.Element, Bucket);
+               end;
 
-   procedure Insert (Container : in out Set;
-                     New_Item  : in     Element_Type;
-                     Position  :    out Cursor;
-                     Inserted  :    out Boolean) is
+               Length := Length + 1;
+            end if;
+         end Process;
 
-      function New_Node (Next : Node_Access) return Node_Access;
-      pragma Inline (New_Node);
+      --  Start of processing for Iterate_Left
 
-      function New_Node (Next : Node_Access) return Node_Access is
-         Element : Element_Access := new Element_Type'(New_Item);
       begin
-         return new Node_Type'(Element, Next);
+         Iterate (Left.HT);
       exception
          when others =>
-            Free_Element (Element);
+            HT_Ops.Free_Hash_Table (Buckets);
             raise;
-      end New_Node;
+      end Iterate_Left;
 
-      procedure Insert is
-        new Element_Keys.Generic_Conditional_Insert (New_Node);
+      return (Controlled with HT => (Buckets, Length, 0, 0));
+   end Difference;
 
+   -------------
+   -- Element --
+   -------------
+
+   function Element (Position : Cursor) return Element_Type is
    begin
+      return Position.Node.Element.all;
+   end Element;
 
-      HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
-      Insert (Container, New_Item, Position.Node, Inserted);
-      Position.Container := Container'Unchecked_Access;
+   ---------------------
+   -- Equivalent_Sets --
+   ---------------------
 
-   end Insert;
+   function Equivalent_Sets (Left, Right : Set) return Boolean is
+   begin
+      return Is_Equivalent (Left.HT, Right.HT);
+   end Equivalent_Sets;
 
+   -------------------------
+   -- Equivalent_Elements --
+   -------------------------
 
-   procedure Insert (Container : in out Set;
-                     New_Item  : in     Element_Type) is
+   function Equivalent_Elements (Left, Right : Cursor)
+     return Boolean is
+   begin
+      return Equivalent_Elements
+               (Left.Node.Element.all,
+                Right.Node.Element.all);
+   end Equivalent_Elements;
 
-      Position : Cursor;
-      Inserted : Boolean;
+   function Equivalent_Elements (Left : Cursor; Right : Element_Type)
+     return Boolean is
+   begin
+      return Equivalent_Elements (Left.Node.Element.all, Right);
+   end Equivalent_Elements;
 
+   function Equivalent_Elements (Left : Element_Type; Right : Cursor)
+     return Boolean is
    begin
+      return Equivalent_Elements (Left, Right.Node.Element.all);
+   end Equivalent_Elements;
 
-      Insert (Container, New_Item, Position, Inserted);
+   ---------------------
+   -- Equivalent_Keys --
+   ---------------------
 
-      if not Inserted then
-         raise Constraint_Error;
-      end if;
+   function Equivalent_Keys (Key : Element_Type; Node : Node_Access)
+     return Boolean is
+   begin
+      return Equivalent_Elements (Key, Node.Element.all);
+   end Equivalent_Keys;
 
-   end Insert;
+   -------------
+   -- Exclude --
+   -------------
 
+   procedure Exclude
+     (Container : in out Set;
+      Item      : Element_Type)
+   is
+      X : Node_Access;
+   begin
+      Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
+      Free (X);
+   end Exclude;
 
-   procedure Replace (Container : in out Set;
-                      New_Item  : in     Element_Type) is
+   --------------
+   -- Finalize --
+   --------------
 
-      Node : constant Node_Access :=
-        Element_Keys.Find (Container, New_Item);
+   procedure Finalize (Container : in out Set) is
+   begin
+      HT_Ops.Finalize (Container.HT);
+   end Finalize;
 
-      X : Element_Access;
+   ----------
+   -- Find --
+   ----------
 
-   begin
+   function Find
+     (Container : Set;
+      Item      : Element_Type) return Cursor
+   is
+      Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
 
+   begin
       if Node = null then
-         raise Constraint_Error;
+         return No_Element;
       end if;
 
-      X := Node.Element;
+      return Cursor'(Container'Unrestricted_Access, Node);
+   end Find;
 
-      Node.Element := new Element_Type'(New_Item);
+   --------------------
+   -- Find_Equal_Key --
+   --------------------
 
-      Free_Element (X);
+   function Find_Equal_Key
+     (R_HT   : Hash_Table_Type;
+      L_Node : Node_Access) return Boolean
+   is
+      R_Index : constant Hash_Type :=
+                  Element_Keys.Index (R_HT, L_Node.Element.all);
 
-   end Replace;
+      R_Node  : Node_Access := R_HT.Buckets (R_Index);
 
+   begin
+      loop
+         if R_Node = null then
+            return False;
+         end if;
 
-   procedure Include (Container : in out Set;
-                      New_Item  : in     Element_Type) is
+         if L_Node.Element.all = R_Node.Element.all then
+            return True;
+         end if;
 
-      Position : Cursor;
-      Inserted : Boolean;
+         R_Node := Next (R_Node);
+      end loop;
+   end Find_Equal_Key;
 
-      X : Element_Access;
+   -------------------------
+   -- Find_Equivalent_Key --
+   -------------------------
 
-   begin
+   function Find_Equivalent_Key
+     (R_HT   : Hash_Table_Type;
+      L_Node : Node_Access) return Boolean
+   is
+      R_Index : constant Hash_Type :=
+                  Element_Keys.Index (R_HT, L_Node.Element.all);
 
-      Insert (Container, New_Item, Position, Inserted);
+      R_Node  : Node_Access := R_HT.Buckets (R_Index);
 
-      if not Inserted then
+   begin
+      loop
+         if R_Node = null then
+            return False;
+         end if;
 
-         X := Position.Node.Element;
+         if Equivalent_Elements (L_Node.Element.all, R_Node.Element.all) then
+            return True;
+         end if;
 
-         Position.Node.Element := new Element_Type'(New_Item);
+         R_Node := Next (R_Node);
+      end loop;
+   end Find_Equivalent_Key;
 
-         Free_Element (X);
+   -----------
+   -- First --
+   -----------
 
-      end if;
+   function First (Container : Set) return Cursor is
+      Node : constant Node_Access := HT_Ops.First (Container.HT);
 
-   end Include;
+   begin
+      if Node = null then
+         return No_Element;
+      end if;
 
+      return Cursor'(Container'Unrestricted_Access, Node);
+   end First;
 
-   procedure Delete (Container : in out Set;
-                     Item      : in     Element_Type) is
+   ----------
+   -- Free --
+   ----------
 
-      X : Node_Access;
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
 
    begin
-
-      Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
-
       if X = null then
-         raise Constraint_Error;
+         return;
       end if;
 
-      Free (X);
+      begin
+         Free_Element (X.Element);
+      exception
+         when others =>
+            X.Element := null;
+            Deallocate (X);
+            raise;
+      end;
 
-   end Delete;
+      Deallocate (X);
+   end Free;
 
+   -----------------
+   -- Has_Element --
+   -----------------
 
-   procedure Exclude (Container : in out Set;
-                      Item      : in     Element_Type) is
+   function Has_Element (Position : Cursor) return Boolean is
+   begin
+      if Position.Node = null then
+         pragma Assert (Position.Container = null);
+         return False;
+      end if;
 
-      X : Node_Access;
+      return True;
+   end Has_Element;
+
+   ---------------
+   -- Hash_Node --
+   ---------------
 
+   function Hash_Node (Node : Node_Access) return Hash_Type is
    begin
+      return Hash (Node.Element.all);
+   end Hash_Node;
 
-      Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
-      Free (X);
+   -------------
+   -- Include --
+   -------------
 
-   end Exclude;
+   procedure Include
+     (Container : in out Set;
+      New_Item  : Element_Type)
+   is
+      Position : Cursor;
+      Inserted : Boolean;
 
+      X : Element_Access;
 
-   procedure Delete (Container : in out Set;
-                     Position  : in out Cursor) is
    begin
+      Insert (Container, New_Item, Position, Inserted);
 
-      if Position = No_Element then
-         return;
-      end if;
+      if not Inserted then
+         if Container.HT.Lock > 0 then
+            raise Program_Error;
+         end if;
 
-      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
-         raise Program_Error;
-      end if;
+         X := Position.Node.Element;
 
-      HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
-      Free (Position.Node);
+         Position.Node.Element := new Element_Type'(New_Item);
 
-      Position.Container := null;
+         Free_Element (X);
+      end if;
+   end Include;
 
-   end Delete;
+   ------------
+   -- Insert --
+   ------------
 
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type;
+      Position  : out Cursor;
+      Inserted  : out Boolean)
+   is
+      function New_Node (Next : Node_Access) return Node_Access;
+      pragma Inline (New_Node);
 
+      procedure Insert is
+         new Element_Keys.Generic_Conditional_Insert (New_Node);
 
-   procedure Union (Target : in out Set;
-                    Source : in     Set) is
+      --------------
+      -- New_Node --
+      --------------
 
-      procedure Process (Src_Node : in Node_Access);
+      function New_Node (Next : Node_Access) return Node_Access is
+         Element : Element_Access := new Element_Type'(New_Item);
 
-      procedure Process (Src_Node : in Node_Access) is
+      begin
+         return new Node_Type'(Element, Next);
+      exception
+         when others =>
+            Free_Element (Element);
+            raise;
+      end New_Node;
 
-         Src : Element_Type renames Src_Node.Element.all;
+      HT : Hash_Table_Type renames Container.HT;
 
-         function New_Node (Next : Node_Access) return Node_Access;
-         pragma Inline (New_Node);
+   --  Start of processing for Insert
 
-         function New_Node (Next : Node_Access) return Node_Access is
-            Tgt : Element_Access := new Element_Type'(Src);
-         begin
-            return new Node_Type'(Tgt, Next);
-         exception
-            when others =>
-               Free_Element (Tgt);
-               raise;
-         end New_Node;
+   begin
+      if HT.Length >= HT_Ops.Capacity (HT) then
+         --  TODO: optimize this (see a-cohase.adb)
+         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      end if;
 
-         procedure Insert is
-            new Element_Keys.Generic_Conditional_Insert (New_Node);
+      Insert (HT, New_Item, Position.Node, Inserted);
+      Position.Container := Container'Unchecked_Access;
+   end Insert;
 
-         Tgt_Node : Node_Access;
-         Success  : Boolean;
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type)
+   is
+      Position : Cursor;
+      Inserted : Boolean;
 
-      begin
+   begin
+      Insert (Container, New_Item, Position, Inserted);
 
-         Insert (Target, Src, Tgt_Node, Success);
+      if not Inserted then
+         raise Constraint_Error;
+      end if;
+   end Insert;
 
-      end Process;
+   ------------------
+   -- Intersection --
+   ------------------
 
-      procedure Iterate is
-         new HT_Ops.Generic_Iteration (Process);
+   procedure Intersection
+     (Target : in out Set;
+      Source : Set)
+   is
+      Tgt_Node : Node_Access;
 
    begin
-
       if Target'Address = Source'Address then
          return;
       end if;
 
-      HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
-
-      Iterate (Source);
+      if Source.Length = 0 then
+         Clear (Target);
+         return;
+      end if;
 
-   end Union;
+      if Target.HT.Busy > 0 then
+         raise Program_Error;
+      end if;
 
+      --  TODO: optimize this to use an explicit
+      --  loop instead of an active iterator
+      --  (similar to how a passive iterator is
+      --  implemented).
+      --
+      --  Another possibility is to test which
+      --  set is smaller, and iterate over the
+      --  smaller set.
 
+      Tgt_Node := HT_Ops.First (Target.HT);
+      while Tgt_Node /= null loop
+         if Is_In (Source.HT, Tgt_Node) then
+            Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
 
-   function Union (Left, Right : Set) return Set is
+         else
+            declare
+               X : Node_Access := Tgt_Node;
+            begin
+               Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
+               HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
+               Free (X);
+            end;
+         end if;
+      end loop;
+   end Intersection;
 
+   function Intersection (Left, Right : Set) return Set is
       Buckets : HT_Types.Buckets_Access;
       Length  : Count_Type;
 
    begin
-
       if Left'Address = Right'Address then
          return Left;
       end if;
 
-      if Right.Length = 0 then
-         return Left;
-      end if;
+      Length := Count_Type'Min (Left.Length, Right.Length);
 
-      if Left.Length = 0 then
-         return Right;
+      if Length = 0 then
+         return Empty_Set;
       end if;
 
       declare
-         Size : constant Hash_Type :=
-           Prime_Numbers.To_Prime (Left.Length + Right.Length);
+         Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
       begin
          Buckets := new Buckets_Type (0 .. Size - 1);
       end;
 
-      declare
+      Length := 0;
+
+      Iterate_Left : declare
          procedure Process (L_Node : Node_Access);
 
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
+
+         -------------
+         -- Process --
+         -------------
+
          procedure Process (L_Node : Node_Access) is
-            I : constant Hash_Type :=
-              Hash (L_Node.Element.all) mod Buckets'Length;
          begin
-            Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
+            if Is_In (Right.HT, L_Node) then
+               declare
+                  Indx : constant Hash_Type :=
+                           Hash (L_Node.Element.all) mod Buckets'Length;
+
+                  Bucket : Node_Access renames Buckets (Indx);
+
+               begin
+                  Bucket := new Node_Type'(L_Node.Element, Bucket);
+               end;
+
+               Length := Length + 1;
+            end if;
          end Process;
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
+      --  Start of processing for Iterate_Left
+
       begin
-         Iterate (Left);
+         Iterate (Left.HT);
       exception
          when others =>
             HT_Ops.Free_Hash_Table (Buckets);
             raise;
-      end;
+      end Iterate_Left;
 
-      Length := Left.Length;
+      return (Controlled with HT => (Buckets, Length, 0, 0));
+   end Intersection;
 
-      declare
-         procedure Process (Src_Node : Node_Access);
+   --------------
+   -- Is_Empty --
+   --------------
 
-         procedure Process (Src_Node : Node_Access) is
+   function Is_Empty (Container : Set) return Boolean is
+   begin
+      return Container.Length = 0;
+   end Is_Empty;
 
-            Src : Element_Type renames Src_Node.Element.all;
+   -----------
+   -- Is_In --
+   -----------
 
-            I : constant Hash_Type :=
-              Hash (Src) mod Buckets'Length;
+   function Is_In (HT  : Hash_Table_Type; Key : Node_Access) return Boolean is
+   begin
+      return Element_Keys.Find (HT, Key.Element.all) /= null;
+   end Is_In;
 
-            Tgt_Node : Node_Access := Buckets (I);
+   ---------------
+   -- Is_Subset --
+   ---------------
 
-         begin
+   function Is_Subset
+     (Subset : Set;
+      Of_Set : Set) return Boolean
+   is
+      Subset_Node : Node_Access;
 
-            while Tgt_Node /= null loop
+   begin
+      if Subset'Address = Of_Set'Address then
+         return True;
+      end if;
 
-               if Equivalent_Keys (Src, Tgt_Node.Element.all) then
-                  return;
-               end if;
+      if Subset.Length > Of_Set.Length then
+         return False;
+      end if;
 
-               Tgt_Node := Next (Tgt_Node);
+      --  TODO: rewrite this to loop in the
+      --  style of a passive iterator.
 
-            end loop;
+      Subset_Node := HT_Ops.First (Subset.HT);
+      while Subset_Node /= null loop
+         if not Is_In (Of_Set.HT, Subset_Node) then
+            return False;
+         end if;
 
-            declare
-               Tgt : Element_Access := new Element_Type'(Src);
-            begin
-               Buckets (I) := new Node_Type'(Tgt, Buckets (I));
-            exception
-               when others =>
-                  Free_Element (Tgt);
-                  raise;
-            end;
+         Subset_Node := HT_Ops.Next (Subset.HT, Subset_Node);
+      end loop;
 
-            Length := Length + 1;
+      return True;
+   end Is_Subset;
 
-         end Process;
+   -------------
+   -- Iterate --
+   -------------
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
-      begin
-         Iterate (Right);
-      exception
-         when others =>
-            HT_Ops.Free_Hash_Table (Buckets);
-            raise;
-      end;
+   procedure Iterate
+     (Container : Set;
+      Process   : not null access procedure (Position : Cursor))
+   is
+      procedure Process_Node (Node : Node_Access);
+      pragma Inline (Process_Node);
 
-      return (Controlled with Buckets, Length);
+      procedure Iterate is
+         new HT_Ops.Generic_Iteration (Process_Node);
 
-   end Union;
+      ------------------
+      -- Process_Node --
+      ------------------
 
+      procedure Process_Node (Node : Node_Access) is
+      begin
+         Process (Cursor'(Container'Unrestricted_Access, Node));
+      end Process_Node;
 
-   function Is_In
-     (HT  : Set;
-      Key : Node_Access) return Boolean;
-   pragma Inline (Is_In);
+      HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
+      B  : Natural renames HT.Busy;
+
+   --  Start of processing for Iterate
 
-   function Is_In
-     (HT  : Set;
-      Key : Node_Access) return Boolean is
    begin
-      return Element_Keys.Find (HT, Key.Element.all) /= null;
-   end Is_In;
+      B := B + 1;
 
+      begin
+         Iterate (HT);
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
 
-   procedure Intersection (Target : in out Set;
-                           Source : in     Set) is
+      B := B - 1;
+   end Iterate;
 
-      Tgt_Node : Node_Access;
+   ------------
+   -- Length --
+   ------------
 
+   function Length (Container : Set) return Count_Type is
    begin
+      return Container.HT.Length;
+   end Length;
 
-      if Target'Address = Source'Address then
-         return;
-      end if;
-
-      if Source.Length = 0 then
-         Clear (Target);
-         return;
-      end if;
-
-      --  TODO: optimize this to use an explicit
-      --  loop instead of an active iterator
-      --  (similar to how a passive iterator is
-      --  implemented).
-      --
-      --  Another possibility is to test which
-      --  set is smaller, and iterate over the
-      --  smaller set.
-
-      Tgt_Node := HT_Ops.First (Target);
+   ----------
+   -- Move --
+   ----------
 
-      while Tgt_Node /= null loop
+   procedure Move (Target : in out Set; Source : in out Set) is
+   begin
+      HT_Ops.Move (Target => Target.HT, Source => Source.HT);
+   end Move;
 
-         if Is_In (Source, Tgt_Node) then
+   ----------
+   -- Next --
+   ----------
 
-            Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
+   function Next (Node : Node_Access) return Node_Access is
+   begin
+      return Node.Next;
+   end Next;
 
-         else
+   function Next (Position : Cursor) return Cursor is
+   begin
+      if Position.Node = null then
+         pragma Assert (Position.Container = null);
+         return No_Element;
+      end if;
 
-            declare
-               X : Node_Access := Tgt_Node;
-            begin
-               Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
-               HT_Ops.Delete_Node_Sans_Free (Target, X);
-               Free (X);
-            end;
+      declare
+         HT   : Hash_Table_Type renames Position.Container.HT;
+         Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
 
+      begin
+         if Node = null then
+            return No_Element;
          end if;
 
-      end loop;
-
-   end Intersection;
+         return Cursor'(Position.Container, Node);
+      end;
+   end Next;
 
+   procedure Next (Position : in out Cursor) is
+   begin
+      Position := Next (Position);
+   end Next;
 
-   function Intersection (Left, Right : Set) return Set is
+   -------------
+   -- Overlap --
+   -------------
 
-      Buckets : HT_Types.Buckets_Access;
-      Length  : Count_Type;
+   function Overlap (Left, Right : Set) return Boolean is
+      Left_Node : Node_Access;
 
    begin
+      if Right.Length = 0 then
+         return False;
+      end if;
 
       if Left'Address = Right'Address then
-         return Left;
+         return True;
       end if;
 
-      Length := Count_Type'Min (Left.Length, Right.Length);
-
-      if Length = 0 then
-         return Empty_Set;
-      end if;
+      Left_Node := HT_Ops.First (Left.HT);
+      while Left_Node /= null loop
+         if Is_In (Right.HT, Left_Node) then
+            return True;
+         end if;
 
-      declare
-         Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
-      begin
-         Buckets := new Buckets_Type (0 .. Size - 1);
-      end;
+         Left_Node := HT_Ops.Next (Left.HT, Left_Node);
+      end loop;
 
-      Length := 0;
+      return False;
+   end Overlap;
 
-      declare
-         procedure Process (L_Node : Node_Access);
+   -------------------
+   -- Query_Element --
+   -------------------
 
-         procedure Process (L_Node : Node_Access) is
-         begin
-            if Is_In (Right, L_Node) then
+   procedure Query_Element
+     (Position : Cursor;
+      Process  : not null access procedure (Element : Element_Type))
+   is
+      E : Element_Type renames Position.Node.Element.all;
 
-               declare
-                  I : constant Hash_Type :=
-                    Hash (L_Node.Element.all) mod Buckets'Length;
-               begin
-                  Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
-               end;
+      HT : Hash_Table_Type renames
+             Position.Container'Unrestricted_Access.all.HT;
 
-               Length := Length + 1;
+      B : Natural renames HT.Busy;
+      L : Natural renames HT.Lock;
 
-            end if;
-         end Process;
+   begin
+      B := B + 1;
+      L := L + 1;
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
       begin
-         Iterate (Left);
+         Process (E);
       exception
          when others =>
-            HT_Ops.Free_Hash_Table (Buckets);
+            L := L - 1;
+            B := B - 1;
             raise;
       end;
 
-      return (Controlled with Buckets, Length);
-
-   end Intersection;
+      L := L - 1;
+      B := B - 1;
+   end Query_Element;
 
+   ----------
+   -- Read --
+   ----------
 
-   procedure Difference (Target : in out Set;
-                         Source : in     Set) is
+   procedure Read
+     (Stream    : access Root_Stream_Type'Class;
+      Container : out Set)
+   is
+   begin
+      Read_Nodes (Stream, Container.HT);
+   end Read;
 
+   ---------------
+   -- Read_Node --
+   ---------------
 
-      Tgt_Node : Node_Access;
+   function Read_Node
+     (Stream : access Root_Stream_Type'Class) return Node_Access
+   is
+      X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
 
    begin
+      return new Node_Type'(X, null);
+   exception
+      when others =>
+         Free_Element (X);
+         raise;
+   end Read_Node;
 
-      if Target'Address = Source'Address then
-         Clear (Target);
-         return;
-      end if;
+   -------------
+   -- Replace --
+   -------------
 
-      if Source.Length = 0 then
-         return;
-      end if;
+   procedure Replace
+     (Container : in out Set;
+      New_Item  : Element_Type)
+   is
+      Node : constant Node_Access :=
+               Element_Keys.Find (Container.HT, New_Item);
+
+      X : Element_Access;
 
-      --  TODO: As I noted above, this can be
-      --  written in terms of a loop instead as
-      --  active-iterator style, sort of like a
-      --  passive iterator.
+   begin
+      if Node = null then
+         raise Constraint_Error;
+      end if;
 
-      Tgt_Node := HT_Ops.First (Target);
+      if Container.HT.Lock > 0 then
+         raise Program_Error;
+      end if;
 
-      while Tgt_Node /= null loop
+      X := Node.Element;
 
-         if Is_In (Source, Tgt_Node) then
+      Node.Element := new Element_Type'(New_Item);
 
-            declare
-               X : Node_Access := Tgt_Node;
-            begin
-               Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
-               HT_Ops.Delete_Node_Sans_Free (Target, X);
-               Free (X);
-            end;
+      Free_Element (X);
+   end Replace;
 
-         else
+   ---------------------
+   -- Replace_Element --
+   ---------------------
 
-            Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
+   procedure Replace_Element
+     (HT      : in out Hash_Table_Type;
+      Node    : Node_Access;
+      Element : Element_Type)
+   is
+   begin
+      if Equivalent_Elements (Node.Element.all, Element) then
+         pragma Assert (Hash (Node.Element.all) = Hash (Element));
 
+         if HT.Lock > 0 then
+            raise Program_Error;
          end if;
 
-      end loop;
+         declare
+            X : Element_Access := Node.Element;
+         begin
+            Node.Element := new Element_Type'(Element);  --  OK if fails
+            Free_Element (X);
+         end;
 
-   end Difference;
+         return;
+      end if;
 
+      if HT.Busy > 0 then
+         raise Program_Error;
+      end if;
 
+      HT_Ops.Delete_Node_Sans_Free (HT, Node);
 
-   function Difference (Left, Right : Set) return Set is
+      Insert_New_Element : declare
+         function New_Node (Next : Node_Access) return Node_Access;
+         pragma Inline (New_Node);
 
-      Buckets : HT_Types.Buckets_Access;
-      Length  : Count_Type;
+         procedure Insert is
+            new Element_Keys.Generic_Conditional_Insert (New_Node);
 
-   begin
+         ------------------------
+         -- Insert_New_Element --
+         ------------------------
 
-      if Left'Address = Right'Address then
-         return Empty_Set;
-      end if;
+         function New_Node (Next : Node_Access) return Node_Access is
+         begin
+            Node.Element := new Element_Type'(Element);  -- OK if fails
+            Node.Next := Next;
+            return Node;
+         end New_Node;
 
-      if Left.Length = 0 then
-         return Empty_Set;
-      end if;
+         Result   : Node_Access;
+         Inserted : Boolean;
 
-      if Right.Length = 0 then
-         return Left;
-      end if;
+         X : Element_Access := Node.Element;
+
+      --  Start of processing for Insert_New_Element
 
-      declare
-         Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
       begin
-         Buckets := new Buckets_Type (0 .. Size - 1);
-      end;
+         Attempt_Insert : begin
+            Insert
+              (HT       => HT,
+               Key      => Element,
+               Node     => Result,
+               Inserted => Inserted);
+         exception
+            when others =>
+               Inserted := False;  -- Assignment failed
+         end Attempt_Insert;
 
-      Length := 0;
+         if Inserted then
+            pragma Assert (Result = Node);
+            Free_Element (X);  -- Just propagate if fails
+            return;
+         end if;
+      end Insert_New_Element;
 
+      Reinsert_Old_Element :
       declare
-         procedure Process (L_Node : Node_Access);
+         function New_Node (Next : Node_Access) return Node_Access;
+         pragma Inline (New_Node);
 
-         procedure Process (L_Node : Node_Access) is
-         begin
-            if not Is_In (Right, L_Node) then
+         procedure Insert is
+            new Element_Keys.Generic_Conditional_Insert (New_Node);
 
-               declare
-                  I : constant Hash_Type :=
-                    Hash (L_Node.Element.all) mod Buckets'Length;
-               begin
-                  Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
-               end;
+         --------------
+         -- New_Node --
+         --------------
 
-               Length := Length + 1;
+         function New_Node (Next : Node_Access) return Node_Access is
+         begin
+            Node.Next := Next;
+            return Node;
+         end New_Node;
 
-            end if;
-         end Process;
+         Result   : Node_Access;
+         Inserted : Boolean;
+
+      --  Start of processing for Reinsert_Old_Element
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
       begin
-         Iterate (Left);
+         Insert
+           (HT       => HT,
+            Key      => Node.Element.all,
+            Node     => Result,
+            Inserted => Inserted);
       exception
          when others =>
-            HT_Ops.Free_Hash_Table (Buckets);
-            raise;
-      end;
+            null;
+      end Reinsert_Old_Element;
 
-      return (Controlled with Buckets, Length);
+      raise Program_Error;
+   end Replace_Element;
 
-   end Difference;
+   procedure Replace_Element
+     (Container : Set;
+      Position  : Cursor;
+      By        : Element_Type)
+   is
+      HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
+
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
+      if Position.Container /= Set_Access'(Container'Unrestricted_Access) then
+         raise Program_Error;
+      end if;
 
+      Replace_Element (HT, Position.Node, By);
+   end Replace_Element;
 
-   procedure Symmetric_Difference (Target : in out Set;
-                                   Source : in     Set) is
+   ----------------------
+   -- Reserve_Capacity --
+   ----------------------
+
+   procedure Reserve_Capacity
+     (Container : in out Set;
+      Capacity  : Count_Type)
+   is
    begin
+      HT_Ops.Reserve_Capacity (Container.HT, Capacity);
+   end Reserve_Capacity;
+
+   --------------
+   -- Set_Next --
+   --------------
 
+   procedure Set_Next (Node : Node_Access; Next : Node_Access) is
+   begin
+      Node.Next := Next;
+   end Set_Next;
+
+   --------------------------
+   -- Symmetric_Difference --
+   --------------------------
+
+   procedure Symmetric_Difference
+     (Target : in out Set;
+      Source : Set)
+   is
+   begin
       if Target'Address = Source'Address then
          Clear (Target);
          return;
       end if;
 
-      HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
+      if Target.HT.Busy > 0 then
+         raise Program_Error;
+      end if;
 
-      if Target.Length = 0 then
+      declare
+         N : constant Count_Type := Target.Length + Source.Length;
+      begin
+         if N > HT_Ops.Capacity (Target.HT) then
+            HT_Ops.Reserve_Capacity (Target.HT, N);
+         end if;
+      end;
 
-         declare
+      if Target.Length = 0 then
+         Iterate_Source_When_Empty_Target : declare
             procedure Process (Src_Node : Node_Access);
 
+            procedure Iterate is
+               new HT_Ops.Generic_Iteration (Process);
+
+            -------------
+            -- Process --
+            -------------
+
             procedure Process (Src_Node : Node_Access) is
                E : Element_Type renames Src_Node.Element.all;
-               B : Buckets_Type renames Target.Buckets.all;
-               I : constant Hash_Type := Hash (E) mod B'Length;
-               N : Count_Type renames Target.Length;
+               B : Buckets_Type renames Target.HT.Buckets.all;
+               J : constant Hash_Type := Hash (E) mod B'Length;
+               N : Count_Type renames Target.HT.Length;
+
             begin
                declare
                   X : Element_Access := new Element_Type'(E);
                begin
-                  B (I) := new Node_Type'(X, B (I));
+                  B (J) := new Node_Type'(X, B (J));
                exception
                   when others =>
                      Free_Element (X);
@@ -897,29 +1233,35 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
                N := N + 1;
             end Process;
 
-            procedure Iterate is
-               new HT_Ops.Generic_Iteration (Process);
+         --  Start of processing for Iterate_Source_When_Empty_Target
+
          begin
-            Iterate (Source);
-         end;
+            Iterate (Source.HT);
+         end Iterate_Source_When_Empty_Target;
 
       else
-
-         declare
+         Iterate_Source : declare
             procedure Process (Src_Node : Node_Access);
 
+            procedure Iterate is
+               new HT_Ops.Generic_Iteration (Process);
+
+            -------------
+            -- Process --
+            -------------
+
             procedure Process (Src_Node : Node_Access) is
                E : Element_Type renames Src_Node.Element.all;
-               B : Buckets_Type renames Target.Buckets.all;
-               I : constant Hash_Type := Hash (E) mod B'Length;
-               N : Count_Type renames Target.Length;
-            begin
-               if B (I) = null then
+               B : Buckets_Type renames Target.HT.Buckets.all;
+               J : constant Hash_Type := Hash (E) mod B'Length;
+               N : Count_Type renames Target.HT.Length;
 
+            begin
+               if B (J) = null then
                   declare
                      X : Element_Access := new Element_Type'(E);
                   begin
-                     B (I) := new Node_Type'(X, null);
+                     B (J) := new Node_Type'(X, null);
                   exception
                      when others =>
                         Free_Element (X);
@@ -928,24 +1270,23 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
                   N := N + 1;
 
-               elsif Equivalent_Keys (E, B (I).Element.all) then
-
+               elsif Equivalent_Elements (E, B (J).Element.all) then
                   declare
-                     X : Node_Access := B (I);
+                     X : Node_Access := B (J);
                   begin
-                     B (I) := B (I).Next;
+                     B (J) := B (J).Next;
                      N := N - 1;
                      Free (X);
                   end;
 
                else
-
                   declare
-                     Prev : Node_Access := B (I);
+                     Prev : Node_Access := B (J);
                      Curr : Node_Access := Prev.Next;
+
                   begin
                      while Curr /= null loop
-                        if Equivalent_Keys (E, Curr.Element.all) then
+                        if Equivalent_Elements (E, Curr.Element.all) then
                            Prev.Next := Curr.Next;
                            N := N - 1;
                            Free (Curr);
@@ -959,7 +1300,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
                      declare
                         X : Element_Access := new Element_Type'(E);
                      begin
-                        B (I) := new Node_Type'(X, B (I));
+                        B (J) := new Node_Type'(X, B (J));
                      exception
                         when others =>
                            Free_Element (X);
@@ -968,28 +1309,22 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
                      N := N + 1;
                   end;
-
                end if;
             end Process;
 
-            procedure Iterate is
-               new HT_Ops.Generic_Iteration (Process);
-         begin
-            Iterate (Source);
-         end;
+         --  Start of processing for Iterate_Source
 
+         begin
+            Iterate (Source.HT);
+         end Iterate_Source;
       end if;
-
    end Symmetric_Difference;
 
-
    function Symmetric_Difference (Left, Right : Set) return Set is
-
       Buckets : HT_Types.Buckets_Access;
       Length  : Count_Type;
 
    begin
-
       if Left'Address = Right'Address then
          return Empty_Set;
       end if;
@@ -1004,28 +1339,35 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       declare
          Size : constant Hash_Type :=
-           Prime_Numbers.To_Prime (Left.Length + Right.Length);
+                  Prime_Numbers.To_Prime (Left.Length + Right.Length);
       begin
          Buckets := new Buckets_Type (0 .. Size - 1);
       end;
 
       Length := 0;
 
-      declare
+      Iterate_Left : declare
          procedure Process (L_Node : Node_Access);
 
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
+
+         -------------
+         -- Process --
+         -------------
+
          procedure Process (L_Node : Node_Access) is
          begin
-            if not Is_In (Right, L_Node) then
+            if not Is_In (Right.HT, L_Node) then
                declare
                   E : Element_Type renames L_Node.Element.all;
-                  I : constant Hash_Type := Hash (E) mod Buckets'Length;
-               begin
+                  J : constant Hash_Type := Hash (E) mod Buckets'Length;
 
+               begin
                   declare
                      X : Element_Access := new Element_Type'(E);
                   begin
-                     Buckets (I) := new Node_Type'(X, Buckets (I));
+                     Buckets (J) := new Node_Type'(X, Buckets (J));
                   exception
                      when others =>
                         Free_Element (X);
@@ -1037,31 +1379,38 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             end if;
          end Process;
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
+      --  Start of processing for Iterate_Left
+
       begin
-         Iterate (Left);
+         Iterate (Left.HT);
       exception
          when others =>
             HT_Ops.Free_Hash_Table (Buckets);
             raise;
-      end;
+      end Iterate_Left;
 
-      declare
+      Iterate_Right : declare
          procedure Process (R_Node : Node_Access);
 
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
+
+         -------------
+         -- Process --
+         -------------
+
          procedure Process (R_Node : Node_Access) is
          begin
-            if not Is_In (Left, R_Node) then
+            if not Is_In (Left.HT, R_Node) then
                declare
                   E : Element_Type renames R_Node.Element.all;
-                  I : constant Hash_Type := Hash (E) mod Buckets'Length;
-               begin
+                  J : constant Hash_Type := Hash (E) mod Buckets'Length;
 
+               begin
                   declare
                      X : Element_Access := new Element_Type'(E);
                   begin
-                     Buckets (I) := new Node_Type'(X, Buckets (I));
+                     Buckets (J) := new Node_Type'(X, Buckets (J));
                   exception
                      when others =>
                         Free_Element (X);
@@ -1069,406 +1418,396 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
                   end;
 
                   Length := Length + 1;
-
                end;
             end if;
          end Process;
 
-         procedure Iterate is
-            new HT_Ops.Generic_Iteration (Process);
+      --  Start of processing for Iterate_Right
+
       begin
-         Iterate (Right);
+         Iterate (Right.HT);
       exception
          when others =>
             HT_Ops.Free_Hash_Table (Buckets);
             raise;
-      end;
-
-      return (Controlled with Buckets, Length);
+      end Iterate_Right;
 
+      return (Controlled with HT => (Buckets, Length, 0, 0));
    end Symmetric_Difference;
 
+   -----------
+   -- Union --
+   -----------
 
-   function Is_Subset (Subset : Set;
-                       Of_Set : Set) return Boolean is
+   procedure Union
+     (Target : in out Set;
+      Source : Set)
+   is
+      procedure Process (Src_Node : Node_Access);
 
-      Subset_Node : Node_Access;
-
-   begin
+      procedure Iterate is
+         new HT_Ops.Generic_Iteration (Process);
 
-      if Subset'Address = Of_Set'Address then
-         return True;
-      end if;
+      -------------
+      -- Process --
+      -------------
 
-      if Subset.Length > Of_Set.Length then
-         return False;
-      end if;
+      procedure Process (Src_Node : Node_Access) is
+         Src : Element_Type renames Src_Node.Element.all;
 
-      --  TODO: rewrite this to loop in the
-      --  style of a passive iterator.
+         function New_Node (Next : Node_Access) return Node_Access;
+         pragma Inline (New_Node);
 
-      Subset_Node := HT_Ops.First (Subset);
+         procedure Insert is
+            new Element_Keys.Generic_Conditional_Insert (New_Node);
 
-      while Subset_Node /= null loop
-         if not Is_In (Of_Set, Subset_Node) then
-            return False;
-         end if;
+         --------------
+         -- New_Node --
+         --------------
 
-         Subset_Node := HT_Ops.Next (Subset, Subset_Node);
-      end loop;
+         function New_Node (Next : Node_Access) return Node_Access is
+            Tgt : Element_Access := new Element_Type'(Src);
 
-      return True;
+         begin
+            return new Node_Type'(Tgt, Next);
+         exception
+            when others =>
+               Free_Element (Tgt);
+               raise;
+         end New_Node;
 
-   end Is_Subset;
+         Tgt_Node : Node_Access;
+         Success  : Boolean;
 
+      --  Start of processing for Process
 
-   function Overlap (Left, Right : Set) return Boolean is
+      begin
+         Insert (Target.HT, Src, Tgt_Node, Success);
+      end Process;
 
-      Left_Node : Node_Access;
+   --  Start of processing for Union
 
    begin
-
-      if Right.Length = 0 then
-         return False;
+      if Target'Address = Source'Address then
+         return;
       end if;
 
-      if Left'Address = Right'Address then
-         return True;
+      if Target.HT.Busy > 0 then
+         raise Program_Error;
       end if;
 
-      Left_Node := HT_Ops.First (Left);
-
-      while Left_Node /= null loop
-         if Is_In (Right, Left_Node) then
-            return True;
+      declare
+         N : constant Count_Type := Target.Length + Source.Length;
+      begin
+         if N > HT_Ops.Capacity (Target.HT) then
+            HT_Ops.Reserve_Capacity (Target.HT, N);
          end if;
+      end;
 
-         Left_Node := HT_Ops.Next (Left, Left_Node);
-      end loop;
-
-      return False;
-
-   end Overlap;
-
-
-   function Find (Container : Set;
-                  Item      : Element_Type) return Cursor is
+      Iterate (Source.HT);
+   end Union;
 
-      Node : constant Node_Access := Element_Keys.Find (Container, Item);
+   function Union (Left, Right : Set) return Set is
+      Buckets : HT_Types.Buckets_Access;
+      Length  : Count_Type;
 
    begin
-
-      if Node = null then
-         return No_Element;
+      if Left'Address = Right'Address then
+         return Left;
       end if;
 
-      return Cursor'(Container'Unchecked_Access, Node);
-
-   end Find;
-
-
-   function Contains (Container : Set;
-                      Item      : Element_Type) return Boolean is
-   begin
-      return Find (Container, Item) /= No_Element;
-   end Contains;
-
-
-
-   function First (Container : Set) return Cursor is
-      Node : constant Node_Access := HT_Ops.First (Container);
-   begin
-      if Node = null then
-         return No_Element;
+      if Right.Length = 0 then
+         return Left;
       end if;
 
-      return Cursor'(Container'Unchecked_Access, Node);
-   end First;
-
-
---     function First_Element (Container : Set) return Element_Type is
---        Node : constant Node_Access := HT_Ops.First (Container);
---     begin
---        return Node.Element;
---     end First_Element;
-
-
-   function Next (Position : Cursor) return Cursor is
-   begin
-      if Position.Container = null
-        or else Position.Node = null
-      then
-         return No_Element;
+      if Left.Length = 0 then
+         return Right;
       end if;
 
       declare
-         S : Set renames Position.Container.all;
-         Node : constant Node_Access := HT_Ops.Next (S, Position.Node);
+         Size : constant Hash_Type :=
+                  Prime_Numbers.To_Prime (Left.Length + Right.Length);
       begin
-         if Node = null then
-            return No_Element;
-         end if;
-
-         return Cursor'(Position.Container, Node);
+         Buckets := new Buckets_Type (0 .. Size - 1);
       end;
-   end Next;
 
+      Iterate_Left : declare
+         procedure Process (L_Node : Node_Access);
 
-   procedure Next (Position : in out Cursor) is
-   begin
-      Position := Next (Position);
-   end Next;
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
 
+         -------------
+         -- Process --
+         -------------
 
-   function Has_Element (Position : Cursor) return Boolean is
-   begin
-      if Position.Container = null then
-         return False;
-      end if;
+         procedure Process (L_Node : Node_Access) is
+            J : constant Hash_Type :=
+                  Hash (L_Node.Element.all) mod Buckets'Length;
 
-      if Position.Node = null then
-         return False;
-      end if;
+            Bucket : Node_Access renames Buckets (J);
 
-      return True;
-   end Has_Element;
+         begin
+            Bucket := new Node_Type'(L_Node.Element, Bucket);
+         end Process;
 
+      --  Start of processing for Process
 
-   function Equivalent_Keys (Left, Right : Cursor)
-     return Boolean is
-   begin
-      return Equivalent_Keys (Left.Node.Element.all, Right.Node.Element.all);
-   end Equivalent_Keys;
+      begin
+         Iterate (Left.HT);
+      exception
+         when others =>
+            HT_Ops.Free_Hash_Table (Buckets);
+            raise;
+      end Iterate_Left;
 
+      Length := Left.Length;
 
-   function Equivalent_Keys (Left  : Cursor;
-                             Right : Element_Type)
-    return Boolean is
-   begin
-      return Equivalent_Keys (Left.Node.Element.all, Right);
-   end Equivalent_Keys;
+      Iterate_Right : declare
+         procedure Process (Src_Node : Node_Access);
 
+         procedure Iterate is
+            new HT_Ops.Generic_Iteration (Process);
 
-   function Equivalent_Keys (Left  : Element_Type;
-                             Right : Cursor)
-    return Boolean is
-   begin
-      return Equivalent_Keys (Left, Right.Node.Element.all);
-   end Equivalent_Keys;
+         -------------
+         -- Process --
+         -------------
 
+         procedure Process (Src_Node : Node_Access) is
+            Src : Element_Type renames Src_Node.Element.all;
+            Idx : constant Hash_Type := Hash (Src) mod Buckets'Length;
 
-   procedure Iterate
-     (Container : in Set;
-      Process   : not null access procedure (Position : in Cursor)) is
+            Tgt_Node : Node_Access := Buckets (Idx);
 
-      procedure Process_Node (Node : in Node_Access);
-      pragma Inline (Process_Node);
+         begin
+            while Tgt_Node /= null loop
+               if Equivalent_Elements (Src, Tgt_Node.Element.all) then
+                  return;
+               end if;
+               Tgt_Node := Next (Tgt_Node);
+            end loop;
 
-      procedure Process_Node (Node : in Node_Access) is
-      begin
-         Process (Cursor'(Container'Unchecked_Access, Node));
-      end Process_Node;
+            declare
+               Tgt : Element_Access := new Element_Type'(Src);
+            begin
+               Buckets (Idx) := new Node_Type'(Tgt, Buckets (Idx));
+            exception
+               when others =>
+                  Free_Element (Tgt);
+                  raise;
+            end;
 
-      procedure Iterate is
-         new HT_Ops.Generic_Iteration (Process_Node);
-   begin
-      Iterate (Container);
-   end Iterate;
+            Length := Length + 1;
+         end Process;
 
+      --  Start of processing for Iterate_Right
 
-   function Capacity (Container : Set) return Count_Type
-     renames HT_Ops.Capacity;
+      begin
+         Iterate (Right.HT);
+      exception
+         when others =>
+            HT_Ops.Free_Hash_Table (Buckets);
+            raise;
+      end Iterate_Right;
 
-   procedure Reserve_Capacity
-     (Container : in out Set;
-      Capacity  : in     Count_Type)
-     renames HT_Ops.Ensure_Capacity;
+      return (Controlled with HT => (Buckets, Length, 0, 0));
+   end Union;
 
+   -----------
+   -- Write --
+   -----------
 
-   procedure Write_Node
-     (Stream : access Root_Stream_Type'Class;
-      Node   : in     Node_Access);
-   pragma Inline (Write_Node);
+   procedure Write
+     (Stream    : access Root_Stream_Type'Class;
+      Container : Set)
+   is
+   begin
+      Write_Nodes (Stream, Container.HT);
+   end Write;
+
+   ----------------
+   -- Write_Node --
+   ----------------
 
    procedure Write_Node
      (Stream : access Root_Stream_Type'Class;
-      Node   : in     Node_Access) is
+      Node   : Node_Access)
+   is
    begin
       Element_Type'Output (Stream, Node.Element.all);
    end Write_Node;
 
-   procedure Write_Nodes is
-      new HT_Ops.Generic_Write (Write_Node);
-
-   procedure Write
-     (Stream    : access Root_Stream_Type'Class;
-      Container : in     Set) renames Write_Nodes;
-
-
-   function Read_Node (Stream : access Root_Stream_Type'Class)
-     return Node_Access;
-   pragma Inline (Read_Node);
-
-   function Read_Node (Stream : access Root_Stream_Type'Class)
-     return Node_Access is
-
-      X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
-   begin
-      return new Node_Type'(X, null);
-   exception
-      when others =>
-         Free_Element (X);
-         raise;
-   end Read_Node;
-
-   procedure Read_Nodes is
-      new HT_Ops.Generic_Read (Read_Node);
-
-   procedure Read
-     (Stream    : access Root_Stream_Type'Class;
-      Container :    out Set) renames Read_Nodes;
-
-
    package body Generic_Keys is
 
-      function Equivalent_Keys (Left  : Cursor;
-                                Right : Key_Type)
-        return Boolean is
-      begin
-         return Equivalent_Keys (Right, Left.Node.Element.all);
-      end Equivalent_Keys;
-
-      function Equivalent_Keys (Left  : Key_Type;
-                                Right : Cursor)
-        return Boolean is
-      begin
-         return Equivalent_Keys (Left, Right.Node.Element.all);
-      end Equivalent_Keys;
+      -----------------------
+      -- Local Subprograms --
+      -----------------------
 
-      function Equivalent_Keys
+      function Equivalent_Key_Node
         (Key  : Key_Type;
          Node : Node_Access) return Boolean;
-      pragma Inline (Equivalent_Keys);
+      pragma Inline (Equivalent_Key_Node);
 
-      function Equivalent_Keys
-        (Key  : Key_Type;
-         Node : Node_Access) return Boolean is
-      begin
-         return Equivalent_Keys (Key, Node.Element.all);
-      end Equivalent_Keys;
+      --------------------------
+      -- Local Instantiations --
+      --------------------------
 
       package Key_Keys is
          new Hash_Tables.Generic_Keys
           (HT_Types  => HT_Types,
-           HT_Type   => Set,
-           Null_Node => null,
            Next      => Next,
            Set_Next  => Set_Next,
            Key_Type  => Key_Type,
            Hash      => Hash,
-           Equivalent_Keys => Equivalent_Keys);
+           Equivalent_Keys => Equivalent_Key_Node);
 
+      --------------
+      -- Contains --
+      --------------
 
-      function Find (Container : Set;
-                     Key       : Key_Type)
-         return Cursor is
-
-         Node : constant Node_Access :=
-           Key_Keys.Find (Container, Key);
-
+      function Contains
+        (Container : Set;
+         Key       : Key_Type) return Boolean
+      is
       begin
+         return Find (Container, Key) /= No_Element;
+      end Contains;
 
-         if Node = null then
-            return No_Element;
-         end if;
-
-         return Cursor'(Container'Unchecked_Access, Node);
-
-      end Find;
+      ------------
+      -- Delete --
+      ------------
 
+      procedure Delete
+        (Container : in out Set;
+         Key       : Key_Type)
+      is
+         X : Node_Access;
 
-      function Contains (Container : Set;
-                         Key       : Key_Type) return Boolean is
       begin
-         return Find (Container, Key) /= No_Element;
-      end Contains;
+         Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
 
+         if X = null then
+            raise Constraint_Error;
+         end if;
+
+         Free (X);
+      end Delete;
 
-      function Element (Container : Set;
-                        Key       : Key_Type)
-        return Element_Type is
+      -------------
+      -- Element --
+      -------------
 
-         Node : constant Node_Access := Key_Keys.Find (Container, Key);
+      function Element
+        (Container : Set;
+         Key       : Key_Type) return Element_Type
+      is
+         Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
       begin
          return Node.Element.all;
       end Element;
 
+      -------------------------
+      -- Equivalent_Key_Node --
+      -------------------------
 
-      function Key (Position : Cursor) return Key_Type is
+      function Equivalent_Key_Node
+        (Key  : Key_Type;
+         Node : Node_Access) return Boolean is
       begin
-         return Key (Position.Node.Element.all);
-      end Key;
-
-
---  TODO:
---        procedure Replace (Container : in out Set;
---                           Key       : in     Key_Type;
---                           New_Item  : in     Element_Type) is
-
---           Node : constant Node_Access :=
---             Key_Keys.Find (Container, Key);
-
---        begin
-
---           if Node = null then
---              raise Constraint_Error;
---           end if;
+         return Equivalent_Keys (Key, Node.Element.all);
+      end Equivalent_Key_Node;
 
---           Replace_Element (Container, Node, New_Item);
+      ---------------------
+      -- Equivalent_Keys --
+      ---------------------
 
---        end Replace;
+      function Equivalent_Keys
+        (Left  : Cursor;
+         Right : Key_Type) return Boolean
+      is
+      begin
+         return Equivalent_Keys (Right, Left.Node.Element.all);
+      end Equivalent_Keys;
 
+      function Equivalent_Keys
+        (Left  : Key_Type;
+         Right : Cursor) return Boolean
+      is
+      begin
+         return Equivalent_Keys (Left, Right.Node.Element.all);
+      end Equivalent_Keys;
 
-      procedure Delete (Container : in out Set;
-                        Key       : in     Key_Type) is
+      -------------
+      -- Exclude --
+      -------------
 
+      procedure Exclude
+        (Container : in out Set;
+         Key       : Key_Type)
+      is
          X : Node_Access;
-
       begin
+         Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
+         Free (X);
+      end Exclude;
 
-         Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
+      ----------
+      -- Find --
+      ----------
 
-         if X = null then
-            raise Constraint_Error;
+      function Find
+        (Container : Set;
+         Key       : Key_Type) return Cursor
+      is
+         Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
+
+      begin
+         if Node = null then
+            return No_Element;
          end if;
 
-         Free (X);
+         return Cursor'(Container'Unrestricted_Access, Node);
+      end Find;
 
-      end Delete;
+      ---------
+      -- Key --
+      ---------
 
+      function Key (Position : Cursor) return Key_Type is
+      begin
+         return Key (Position.Node.Element.all);
+      end Key;
 
-      procedure Exclude (Container : in out Set;
-                         Key       : in     Key_Type) is
+      -------------
+      -- Replace --
+      -------------
 
-         X : Node_Access;
+      procedure Replace
+        (Container : in out Set;
+         Key       : Key_Type;
+         New_Item  : Element_Type)
+      is
+         Node : constant Node_Access :=
+                  Key_Keys.Find (Container.HT, Key);
 
       begin
+         if Node = null then
+            raise Constraint_Error;
+         end if;
 
-         Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
-         Free (X);
-
-      end Exclude;
-
+         Replace_Element (Container.HT, Node, New_Item);
+      end Replace;
 
-      procedure Checked_Update_Element
+      procedure Update_Element_Preserving_Key
         (Container : in out Set;
          Position  : in     Cursor;
          Process   : not null access
-           procedure (Element : in out Element_Type)) is
+           procedure (Element : in out Element_Type))
+      is
+         HT : Hash_Table_Type renames Container.HT;
 
       begin
-
-         if Position.Container = null then
+         if Position.Node = null then
             raise Constraint_Error;
          end if;
 
@@ -1477,55 +1816,44 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          end if;
 
          declare
-            Old_Key : Key_Type renames Key (Position.Node.Element.all);
-         begin
-            Process (Position.Node.Element.all);
-
-            if Equivalent_Keys (Old_Key, Position.Node.Element.all) then
-               return;
-            end if;
-         end;
-
-         declare
-            function New_Node (Next : Node_Access) return Node_Access;
-            pragma Inline (New_Node);
+            E : Element_Type renames Position.Node.Element.all;
+            K : Key_Type renames Key (E);
 
-            function New_Node (Next : Node_Access) return Node_Access is
-            begin
-               Position.Node.Next := Next;
-               return Position.Node;
-            end New_Node;
+            B : Natural renames HT.Busy;
+            L : Natural renames HT.Lock;
 
-            procedure Insert is
-               new Key_Keys.Generic_Conditional_Insert (New_Node);
-
-            Result  : Node_Access;
-            Success : Boolean;
          begin
-            HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
+            B := B + 1;
+            L := L + 1;
 
-            Insert
-              (HT      => Container,
-               Key     => Key (Position.Node.Element.all),
-               Node    => Result,
-               Success => Success);
+            begin
+               Process (E);
+            exception
+               when others =>
+                  L := L - 1;
+                  B := B - 1;
+                  raise;
+            end;
 
-            if not Success then
-               declare
-                  X : Node_Access := Position.Node;
-               begin
-                  Free (X);
-               end;
+            L := L - 1;
+            B := B - 1;
 
-               raise Program_Error;
+            if Equivalent_Keys (K, E) then
+               pragma Assert (Hash (K) = Hash (E));
+               return;
             end if;
+         end;
 
-            pragma Assert (Result = Position.Node);
+         declare
+            X : Node_Access := Position.Node;
+         begin
+            HT_Ops.Delete_Node_Sans_Free (HT, X);
+            Free (X);
          end;
 
-      end Checked_Update_Element;
+         raise Program_Error;
+      end Update_Element_Preserving_Key;
 
    end Generic_Keys;
 
 end Ada.Containers.Indefinite_Hashed_Sets;
-