------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--            G N A T C H E C K . N A M E _ D I C T I O N A R Y             --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2005-2007, AdaCore                      --
--                                                                          --
-- GNATCHECK  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.  GNATCHECK  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 GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Text_IO;             use Ada.Text_IO;

--  with GNAT.OS_Lib; use GNAT.OS_Lib;

with ASIS_UL.Misc;            use ASIS_UL.Misc;
with ASIS_UL.Output;          use ASIS_UL.Output;
with ASIS_UL.Strings;         use ASIS_UL.Strings;

with Table;

package body Gnatcheck.Name_Dictionary is

   ---------------------
   -- Name Dictionary --
   ---------------------

   type Dictionary_Id is new Integer range 0 .. Integer'Last;
   No_Dictionary_Entry : constant Dictionary_Id := Dictionary_Id'First;
   First_Dictionary_Id : constant Dictionary_Id := No_Dictionary_Entry + 1;

   function Present (Id : Dictionary_Id) return Boolean;
   --  Checks that Id points to an existing entry in the dictionary.

   type Dictionary_Record is record
      Word : String_Loc;
      --  We use ASIS_UL.Strings storage mechanism to keep words, because we
      --  are not expecting very big dictionaty size here and, therefore, the
      --  corresponding performance prblems. Otherwise we should use access to
      --  string

      Hash_Link : Dictionary_Id;
      --  Link to next entry in dictionary table for same hash code
   end record;

   package Dictionary_Entries is new Table.Table (
     Table_Component_Type => Dictionary_Record,
     Table_Index_Type     => Dictionary_Id,
     Table_Low_Bound      => First_Dictionary_Id,
     Table_Initial        => 100,
     Table_Increment      => 100,
     Table_Name           => "GNATCHECK Name Dictionary");

   package Dictionary_Hash_Table is new
     ASIS_UL.Misc.String_Hash_Table (Entry_Id => Dictionary_Id);
   use Dictionary_Hash_Table;

   procedure Add_To_Dictionary (Name : String);
   --  If Name is not in the dictionary, adds it. (All the names stored in
   --  the dictionary are folded to lower case!)

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Scan_Dictionary (Fname : String);
   --  Supposing that Fname is a name of a dictionary file, scans this file and
   --  fills in the dictionary table.

   -----------------------
   -- Add_To_Dictionary --
   -----------------------

   procedure Add_To_Dictionary (Name : String) is
      Name_To_Add : constant String (1 .. Name'Length) := To_Lower (Name);
      --  Convert casing to lower, and index range - to starting from 1

      Hash_Val            : constant Hash_Index_Type := Hash (Name_To_Add);
      Add_After           :          Dictionary_Id   := Hash_Table (Hash_Val);
      Name_In_Dictionary  :          Boolean         := False;
   begin

      if Present (Add_After) then
         --  Traversing the hash chain
         loop
            if Is_Equal
                 (Name_To_Add, Dictionary_Entries.Table (Add_After).Word)
            then
               Name_In_Dictionary := True;
               exit;
            elsif Present (Dictionary_Entries.Table (Add_After).Hash_Link) then
               Add_After := Dictionary_Entries.Table (Add_After).Hash_Link;
            else
               exit;
            end if;
         end loop;

      end if;

      if not Name_In_Dictionary then
         Dictionary_Entries.Append
           (New_Val => (Word      => Enter_String (Name_To_Add),
                        Hash_Link => No_Dictionary_Entry));

         if Present (Add_After) then
            Dictionary_Entries.Table (Add_After).Hash_Link :=
              Dictionary_Entries.Last;
         else
            Hash_Table (Hash_Val) := Dictionary_Entries.Last;
         end if;

      end if;

   end Add_To_Dictionary;

   ------------------------
   -- Name_In_Dictionary --
   ------------------------

   function Name_In_Dictionary (Name : Wide_String) return Boolean is
      Name_To_Search : constant String (1 .. Name'Length) :=
        To_Lower (To_String (Name));
      --  The name we actually will be looking for in the dictionary

      Result       : Boolean       := False;
      Search_Chain : Dictionary_Id := Hash_Table (Hash (Name_To_Search));
   begin

      while Present (Search_Chain) loop

         if Is_Equal (Name_To_Search,
                      Dictionary_Entries.Table (Search_Chain).Word)
         then
            Result := True;
            exit;
         else
            Search_Chain := Dictionary_Entries.Table (Search_Chain).Hash_Link;
         end if;

      end loop;

      return Result;
   end Name_In_Dictionary;

   -------------
   -- Present --
   -------------

   function Present (Id : Dictionary_Id) return Boolean is
   begin
      return Id in First_Dictionary_Id .. Dictionary_Entries.Last;
   end Present;

   ---------------------
   -- Scan_Dictionary --
   ---------------------

   procedure Scan_Dictionary (Fname : String) is
      Dictionary_File : File_Type;

      Line_Num : Natural := 0;
      --  The number of the currently processed line, used to form diagnostic
      --  messages

      String_Buffer_Max_Len : constant Natural := 1024;
      --  Should be enough, I hope...

      String_Buffer : String (1 .. String_Buffer_Max_Len);
      --  Buffer to place the next dictionary file line in

      Len : Natural range 0 .. String_Buffer_Max_Len := 0;
      --  The length of the dictionary file line which is being processed

      procedure Process_Dictionary_File_Line;
      --  Reads the next line from the dictionary file into String_Buffer,
      --  parses String_Buffer, and adds the located names in the dictionary

      ----------------------------------
      -- Process_Dictionary_File_Line --
      ----------------------------------

      procedure Process_Dictionary_File_Line is
         Start_Word : Natural := 0;
         End_Word   : Natural := 0;

         procedure Get_Next_Word;
         --  Set Start_Word and End_Word topoint to the next word in the
         --  String_Buffer. Set Start_Word to 0 if there is no word any more.

         function Is_Identifier return Boolean;
         --  Check if String_Buffer (Start_Word .. End_Word) satisfies the
         --  syntax of Ada identifier

         function Is_Comment return Boolean;
         --  Check if String_Buffer (Start_Word .. End_Word) is (the beginning
         --  of) the (Ada) comment line

         procedure Get_Next_Word is
         begin
            Start_Word := 0;

            for J in End_Word + 1 .. Len loop

               if not Is_White_Space (String_Buffer (J)) then
                  Start_Word := J;
                  exit;
               end if;

            end loop;

            if Start_Word /= 0 then
               End_Word := Len;

               for J in Start_Word + 1 .. Len loop

                  if Is_White_Space (String_Buffer (J)) then
                     End_Word := J - 1;
                     exit;
                  end if;

               end loop;

            end if;

         end Get_Next_Word;

         function Is_Comment return Boolean is
         begin
            return End_Word > Start_Word
                and then
                   String_Buffer (Start_Word .. End_Word) = "--";
         end Is_Comment;

         function Is_Identifier return Boolean is
            Got_Underscore : Boolean := False;
            Result         : Boolean := True;
         begin

            if not Is_Letter (String_Buffer (Start_Word)) then
               Result := False;
            else

               for J in Start_Word + 1 .. End_Word loop

                  if Is_Alphanumeric (String_Buffer (J)) then
                     Got_Underscore := False;
                  elsif String_Buffer (J) = '_' then

                     if Got_Underscore then
                        Result := False;
                        exit;
                     else
                        Got_Underscore := True;
                     end if;
                  else
                     Result := False;
                     exit;
                  end if;

               end loop;

            end if;

            return Result;

         end Is_Identifier;

      begin  --  Process_Dictionary_File_Line
         Get_Line (Dictionary_File, String_Buffer, Len);

         if Len = 0 then
            --  This is an empty line
            return;
         end if;

         Get_Next_Word;

         while Start_Word /= 0 loop

            if Is_Comment then
               --  nothing to do, the rest of the line is comment
               return;
            elsif Is_Identifier then
               Add_To_Dictionary (String_Buffer (Start_Word .. End_Word));
            else
               Error (Fname & ':' & Image (Line_Num) & ':' &
                      Image (Start_Word) &
                      " illegal word in dictionary, ignored");
            end if;

            Get_Next_Word;

         end loop;

      end Process_Dictionary_File_Line;

   begin
      --  First trying to open the dictionary file:

      begin
         Open (File => Dictionary_File,
               Mode => In_File,
               Name => Fname);
      exception
         when Name_Error =>
            Error ("dictionary file " & Fname & " does not exit");
            return;
         when Status_Error =>
            Error ("can not open  dictionary file " & Fname);
            return;
      end;

      while not End_Of_File (Dictionary_File) loop
         Line_Num := Line_Num + 1;
         Process_Dictionary_File_Line;
      end loop;

      if Is_Open (Dictionary_File) then
         Close (Dictionary_File);
      end if;

   end Scan_Dictionary;

   --------------------------
   -- Scan_Dictionary_File --
   --------------------------

   procedure Scan_Dictionary_File
     (Parameter : String;
      Success   : out Boolean)
   is
   begin
      Success := False;

      Scan_Dictionary (Parameter);

      if Dictionary_Entries.Last >= First_Dictionary_Id then
         Success := True;
      end if;

   end Scan_Dictionary_File;

begin
   Dictionary_Hash_Table.Hash_Table := (others => No_Dictionary_Entry);
end Gnatcheck.Name_Dictionary;
