----------------------------------------------------------------------
--  Dictionary.Table_manager - Package body                         --
--  Copyright (C) 2002 Adalog                                       --
--  Author: J-P. Rosen                                              --
--                                                                  --
--  ADALOG   is   providing   training,   consultancy,   expertise, --
--  assistance and custom developments  in Ada and related software --
--  engineering techniques.  For more info about our services:      --
--  ADALOG                   Tel: +33 1 41 24 31 40                 --
--  19-21 rue du 8 mai 1945  Fax: +33 1 41 24 07 36                 --
--  94110 ARCUEIL            E-m: info@adalog.fr                    --
--  FRANCE                   URL: http://www.adalog.fr              --
--                                                                  --
--  This  unit 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.  This  unit 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 this program; see file --
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
--                                                                  --
--  As  a special  exception, if  other files  instantiate generics --
--  from  this unit,  or you  link this  unit with  other  files to --
--  produce an executable,  this unit does not by  itself cause the --
--  resulting executable  to be covered  by the GNU  General Public --
--  License.  This exception does  not however invalidate any other --
--  reasons why  the executable  file might be  covered by  the GNU --
--  Public License.                                                 --
----------------------------------------------------------------------

with Ada.Unchecked_Deallocation;
package body Dictionary.Table_Manager is

   -- Internal use only
   procedure Free is new Ada.Unchecked_Deallocation (Dictionary_Data, Dictionary_Data_Access);

   function  Find_Node (Key : Wide_String; From : Table) return Link is
      Current : Link;
   begin
      if From.Last_Visited /= null and then Key = From.Last_Visited.Key then
         return From.Last_Visited;
      end if;

      Current := From.Root;
      loop
         if Current = null then
            return null;
         elsif Key = Current.Key then
            From.Myself.Accessor.Last_Visited := Current;
            return Current;
         elsif Key < Current.Key then
            Current := Current.Left;
         else
            Current := Current.Right;
         end if;
      end loop;
   end Find_Node;

   ---------
   -- Add --
   ---------

   procedure Add (Key   : in Wide_String;
                  Value : in Dictionary_Data;
                  To    : in out Table) is
      procedure Add (To_tree : in out Link;
                     Key     : in     Wide_String;
                     Value   : in     Dictionary_Data) is
      begin
         if To_Tree = null then
            To_Tree := new Node'(K_Length     => Key'Length,
                                 Key          => Key,
                                 Value        => new Dictionary_Data'(Value),
                                 Left | Right => null);
            To.Last_Visited := To_Tree;
            return;
         end if;

         if Key < To_Tree.Key then
            Add (To_Tree.Left, Key, Value);
         elsif Key = To_Tree.Key then
            raise Already_Present;
         else
            Add (To_Tree.Right, Key, Value);
         end if;
      end Add;
   begin
      Add (To.Root, Key, Value);
   end Add;

   -------------
   -- Balance --
   -------------

   procedure Balance (The_Table : in out Table) is
      Junk         : Link;
      Count        : Natural := 0;
      Current      : Link;

      procedure Linearize (L : Link; First, Last : out Link) is
         Temp : Link;
      begin
         Count := Count + 1;
         if L.Left /= null then
            Linearize (L.Left, First, Temp);
            Temp.Right := L;
         else
            First := L;
         end if;
         L.Left := null;
         if L.Right = null then
            Last := L;
         else
            Linearize (L.Right, Temp, Last);
            L.Right := Temp;
         end if;
      end Linearize;

      function Rebalance (Size : Natural) return Link is
         Node : Link;
         Left : Link;
      begin
         if Size = 0 then
            return null;
         end if;

         if Size = 1 then
            Node       := Current;
            Current    := Current.Right;
            Node.Right := null;
            return Node;
         end if;

         Left       := Rebalance ((Size-1) / 2);
         Node       := Current;
         Current    := Current.Right;
         Node.Left  := Left;
         Node.Right := Rebalance (Size - (Size-1)/2 - 1);
         return Node;
      end Rebalance;

   begin
      if The_Table.Root = null then
         return;
      end if;

      Linearize (The_Table.Root, Current, Junk);
      The_Table.Root := Rebalance (Count);
   end Balance;

   -----------
   -- Fetch --
   -----------

   function Fetch(Key : Wide_String; From : Table) return Dictionary_Data is
      Node : constant Link := Find_Node (Key, From);
   begin
      if Node = null then
         raise Not_Present;
      else
         return Node.Value.all;
      end if;
   end Fetch;

   -----------
   -- Fetch --
   -----------

   function  Fetch (Key : Wide_String; From : Table) return Dictionary_Data_Access is
      Node : constant Link := Find_Node (Key, From);
   begin
      if Node = null then
         return null;
      else
         return Node.Value;
      end if;
   end Fetch;

   ----------------
   -- Is_Present --
   ----------------

   function Is_present(Key : Wide_String; Into : Table) return Boolean is
   begin
      return Find_Node (Key, Into) /= null;
   end Is_present;

   -------------
   -- Iterate --
   -------------

   procedure Iterate (Over : Table) is
      procedure Iterate (On : Link) is
      begin
         if On = null then
            return;
         end if;

         Iterate(On.Left);
         Action(On.Key, On.Value.all);
         Iterate(On.Right);
      end Iterate;
   begin
      Iterate (Over.Root);
   end Iterate;

   -------------
   -- Replace --
   -------------

   procedure Replace (Key   : in Wide_String;
                      Value : in Dictionary_Data;
                      Into  : in out Table) is
      Node : Link := Find_Node (Key, Into);
   begin
      if Node = null then
         raise Not_Present;
      end if;

      Free (Node.Value);
      Node.Value := new Dictionary_Data'(Value);
   end Replace;

end Dictionary.Table_Manager;
