------------------------------------------------------------------------------
--                                                                          --
--                      CHARLES CONTAINER LIBRARY                           --
--                                                                          --
--              Copyright (C) 2001-2003 Matthew J Heaney                    --
--                                                                          --
-- The Charles Container Library ("Charles") is free software; you can      --
-- redistribute it and/or modify it under terms of the GNU General Public   --
-- License as published by the Free Software Foundation; either version 2,  --
-- or (at your option) any later version.  Charles is distributed in the    --
-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even the  --
-- implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- See the GNU General Public License for more details.  You should have    --
-- received a copy of the GNU General Public License distributed with       --
-- Charles;  see file COPYING.TXT.  If not, write to the Free Software      --
-- Foundation,  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.    --
--                                                                          --
-- As a special exception, if other files instantiate generics from this    --
-- unit, or you link this unit with other files to produce an executable,   --
-- this unit does not by itself cause the resulting executable to be        --
-- covered by the GNU General Public License.  This exception does not      --
-- however invalidate any other reasons why the executable file might be    --
-- covered by the GNU Public License.                                       --
--                                                                          --
-- Charles is maintained by Matthew J Heaney.                               --
--                                                                          --
-- http://home.earthlink.net/~matthewjheaney/index.html                     --
-- mailto:matthewjheaney@earthlink.net                                      --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Unchecked_Deallocation;
with System;  use type System.Address;

package body Charles.Maps.Hashed.Strings.Unbounded is

   type Node_Type (Key_Length : Natural) is
      record
         Key     : String (1 .. Key_Length);
         Element : aliased Element_Type;
         Next    : Node_Access;
      end record;

   function "=" (L, R : Node_Type) return Boolean is abstract;
   pragma Warnings (Off, "=");


   procedure Set_Next
     (Node : Node_Access;
      Next : Node_Access) is
   begin
      Node.Next := Next;
   end;

   function Next (Node : Node_Access) return Node_Access is
   begin
      return Node.Next;
   end;

   procedure Free (X : in out Node_Access) is
      procedure Deallocate is
         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
   begin
      Deallocate (X);
   end;


   function Hash (Node : Node_Access) return Hash_Type is
   begin
      return Hash (Node.Key);
   end;


   function Copy_Node (Source : Node_Access) return Node_Access is
   begin
      return new Node_Type'(Key_Length => Source.Key_Length,
                            Key        => Source.Key,
                            Element    => Source.Element,
                            Next       => null);
   end;

   procedure Adjust is
      new Hash_Table_Types.Generic_Adjust (New_Node => Copy_Node);

   procedure Adjust (Container : in out Container_Type) is
   begin
      Adjust (Container.Hash_Table);
   end;


   procedure Finalize (Container : in out Container_Type) is
   begin
      Finalize (Container.Hash_Table);
   end;


   procedure Assign is
      new Hash_Table_Types.Generic_Assign (New_Node => Copy_Node);

   procedure Assign
     (Target : in out Container_Type;
      Source : in     Container_Type) is
   begin
      Assign (Target.Hash_Table, Source.Hash_Table);
   end;


   function First (Container : Container_Type) return Iterator_Type is
   begin
      return (Node => First (Container.Hash_Table));
   end;


   function First_Key (Container : Container_Type) return String is
      Node : constant Node_Access := First (Container.Hash_Table);
   begin
      return Node.Key;
   end;


   function First_Element (Container : Container_Type) return Element_Type is
      Node : constant Node_Access := First (Container.Hash_Table);
   begin
      return Node.Element;
   end;


   function Back (Container : Container_Type) return Iterator_Type is
      pragma Warnings (Off, Container);
   begin
      return Null_Iterator;
   end;


   function Key (Iterator : Iterator_Type) return String is
   begin
      return Iterator.Node.Key;
   end;


   function Element (Iterator : Iterator_Type) return Element_Type is
   begin
      return Iterator.Node.Element;
   end;


   function Generic_Element (Iterator : Iterator_Type)
      return Element_Access is
   begin
      return Iterator.Node.Element'Access;
   end;


   procedure Replace_Element
     (Iterator : in Iterator_Type;
      By       : in Element_Type) is
   begin
      Iterator.Node.Element := By;
   end;


   function Succ
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Iterator_Type is
   begin
      return (Node => Succ (Container.Hash_Table, Iterator.Node));
   end;


   procedure Increment
     (Container : in     Container_Type;
      Iterator  : in out Iterator_Type) is
   begin
      Iterator := Succ (Container, Iterator);
   end;


   function Is_Equal_Element (L, R : Node_Access) return Boolean is
      pragma Inline (Is_Equal_Element);
   begin
      return L.Element = R.Element;
   end;


   function Is_Equal is
      new Hash_Table_Types.Generic_Equal (Is_Equal_Element);

   function "=" (Left, Right : Container_Type) return Boolean is
   begin
      return Is_Equal (Left.Hash_Table, Right.Hash_Table);
   end;


   function Size (Container : Container_Type) return Natural is
   begin
      return Size (Container.Hash_Table);
   end;


   function Length (Container : Container_Type) return Natural is
   begin
      return Container.Hash_Table.Length;
   end;


   function Is_Equal_Key
     (N : Node_Access;
      K : String) return Boolean is

      pragma Inline (Is_Equal_Key);
   begin
      return Is_Equal_Key (N.Key, K);
   end;


   package Keys is
      new Hash_Table_Types.Generic_Keys (String, Hash, Is_Equal_Key);

   use Keys;


   function Find
     (Container : Container_Type;
      Key       : String) return Iterator_Type is
   begin
      return (Node => Find (Container.Hash_Table, Key));
   end;


   function Element
     (Container : Container_Type;
      Key       : String) return Element_Type is

      Node : constant Node_Access :=
         Find (Container.Hash_Table, Key);
   begin
      return Node.Element;
   end;



   function Is_In
     (Key       : String;
      Container : Container_Type) return Boolean is
   begin
      return Find (Container, Key) /= Back (Container);
   end;


   function Is_Empty (Container : Container_Type) return Boolean is
   begin
      return Length (Container) = 0;
   end;


   procedure Clear (Container : in out Container_Type) is
   begin
      Clear (Container.Hash_Table);
   end;


   procedure Swap (Left, Right : in out Container_Type) is
   begin
      Swap (Left.Hash_Table, Right.Hash_Table);
   end;


   procedure Insert
     (Container : in out Container_Type;
      Key       : in     String;
      New_Item  : in     Element_Type;
      Iterator  :    out Iterator_Type;
      Success   :    out Boolean) is

      function New_Node (Next : Node_Access) return Node_Access is
      begin
         return new Node_Type'(Key_Length => Key'Length,
                               Key        => Key,
                               Element    => New_Item,
                               Next       => Next);
      end;

      procedure Insert is
         new Keys.Generic_Conditional_Insert (New_Node);

   begin

      Resize (Container, Length (Container) + 1);

      Insert (Container.Hash_Table, Key, Iterator.Node, Success);

   end Insert;



   procedure Insert
     (Container : in out Container_Type;
      Key       : in     String;
      Iterator  :    out Iterator_Type;
      Success   :    out Boolean) is

      function New_Node (Next : Node_Access) return Node_Access is
         Node : Node_Access := new Node_Type (Key'Length);
      begin
         Node.Key := Key;
         Node.Next := Next;

         return Node;
      exception
         when others =>
            Free (Node);
            raise;
      end;

      procedure Insert is
         new Keys.Generic_Conditional_Insert (New_Node);

   begin

      Resize (Container, Length (Container) + 1);

      Insert (Container.Hash_Table, Key, Iterator.Node, Success);

   end Insert;


   procedure Insert
     (Container : in out Container_Type;
      Key       : in     String;
      New_Item  : in     Element_Type) is

      Iterator : Iterator_Type;
      Success  : Boolean;
   begin
      Insert (Container, Key, New_Item, Iterator, Success);
   end;


   procedure Insert
     (Container : in out Container_Type;
      Key       : in     String) is

      Iterator : Iterator_Type;
      Success  : Boolean;
   begin
      Insert (Container, Key, Iterator, Success);
   end;



   procedure Insert_Sans_Resize
     (Container : in out Container_Type;
      Key       : in     String;
      New_Item  : in     Element_Type;
      Iterator  :    out Iterator_Type;
      Success   :    out Boolean) is

      function New_Node (Next : Node_Access) return Node_Access is
      begin
         return new Node_Type'(Key_Length => Key'Length,
                               Key        => Key,
                               Element    => New_Item,
                               Next       => Next);
      end;

      procedure Insert is
         new Keys.Generic_Conditional_Insert (New_Node);

   begin

      Resize (Container, Length => 1);

      Insert (Container.Hash_Table, Key, Iterator.Node, Success);

   end Insert_Sans_Resize;


   procedure Insert_Sans_Resize
     (Container : in out Container_Type;
      Key       : in     String;
      New_Item  : in     Element_Type) is

      Iterator : Iterator_Type;
      Success  : Boolean;
   begin
      Insert_Sans_Resize (Container, Key, New_Item, Iterator, Success);
   end;


   procedure Insert_Sans_Resize
     (Container : in out Container_Type;
      Key       : in     String;
      Iterator  :    out Iterator_Type;
      Success   :    out Boolean) is

      function New_Node (Next : Node_Access) return Node_Access is
         Node : Node_Access := new Node_Type (Key'Length);
      begin
         Node.Key := Key;
         Node.Next := Next;

         return Node;
      exception
         when others =>
            Free (Node);
            raise;
      end;

      procedure Insert is
         new Keys.Generic_Conditional_Insert (New_Node);

   begin

      Resize (Container, Length => 1);

      Insert (Container.Hash_Table, Key, Iterator.Node, Success);

   end Insert_Sans_Resize;


   procedure Insert_Sans_Resize
     (Container : in out Container_Type;
      Key       : in     String) is

      Iterator : Iterator_Type;
      Success  : Boolean;
   begin
      Insert_Sans_Resize (Container, Key, Iterator, Success);
   end;


   procedure Replace
     (Container : in out Container_Type;
      Key       : in     String;
      New_Item  : in     Element_Type) is

      Iterator : Iterator_Type;
      Success  : Boolean;
   begin
      Insert (Container, Key, New_Item, Iterator, Success);

      if not Success then
         Iterator.Node.Element := New_Item;
      end if;
   end;



   procedure Delete
     (Container : in out Container_Type;
      Key       : in     String) is
   begin
      Delete (Container.Hash_Table, Key);
   end;


   procedure Delete
     (Container : in out Container_Type;
      Iterator  : in out Iterator_Type) is
   begin
      Delete (Container.Hash_Table, Iterator.Node);
   end;


   procedure Generic_Iteration
     (Container : in Container_Type) is

      procedure Process (Node : Node_Access) is
         pragma Inline (Process);
      begin
         Process (Iterator_Type'(Node => Node));
      end;

      procedure Iterate is
         new Hash_Table_Types.Generic_Iteration (Process);
   begin
      Iterate (Container.Hash_Table);
   end;



   procedure Resize
     (Container : in out Container_Type;
      Length    : in     Natural) is
   begin
      Resize (Container.Hash_Table, Length);
   end;


   function Is_Equal (Left, Right : Iterator_Type) return Boolean is
   begin
      return Is_Equal_Element (Left.Node, Right.Node);
   end;


   function Is_Equal
     (Left  : Iterator_Type;
      Right : Element_Type) return Boolean is
   begin
      return Left.Node.Element = Right;
   end;


   function Is_Equal
     (Left  : Element_Type;
      Right : Iterator_Type) return Boolean is
   begin
      return Left = Right.Node.Element;
   end;


   function Is_Equal_Key
     (Left, Right : Iterator_Type) return Boolean is
   begin
      return Is_Equal_Key (Left.Node.Key, Right.Node.Key);
   end;


   function Is_Equal_Key
     (Left  : Iterator_Type;
      Right : String) return Boolean is
   begin
      return Is_Equal_Key (Left.Node.Key, Right);
   end;


   function Is_Equal_Key
     (Left  : String;
      Right : Iterator_Type) return Boolean is
   begin
      return Is_Equal_Key (Left, Right.Node.Key);
   end;

end Charles.Maps.Hashed.Strings.Unbounded;

