------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--                         A S I S _ U L . M I S C                          --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                       Copyright (C) 2006, AdaCore                        --
--                                                                          --
-- Asis Utility Library (ASIS UL) 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.  ASIS UL  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, 59 Temple Place  --
--  - Suite 330, Boston,                                                    --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Fixed;

package body ASIS_UL.Misc is

   -----------
   -- Image --
   -----------

   function Image (I : Integer) return String is
   begin
      return Ada.Strings.Fixed.Trim (Integer'Image (I), Ada.Strings.Both);
   end Image;

   -------------------
   -- Is_Identifier --
   -------------------

   function Is_Identifier (S : String) return Boolean is
      Result : Boolean := False;
   begin

      if S'Length > 0
        and then
         Is_Alphanumeric (S (S'First))
      then
         Result := Is_Identifier_Suffix (S (S'First + 1 .. S'Last));
      end if;

      return Result;
   end Is_Identifier;

   --------------------------
   -- Is_Identifier_Suffix --
   --------------------------

   function Is_Identifier_Suffix (Suffix : String) return Boolean is
      Result                  : Boolean := True;
      Last_Char_Was_Underline : Boolean := False;
   begin

      for J in Suffix'Range loop

         if Is_Alphanumeric (Suffix (J)) then
            Last_Char_Was_Underline := False;
         elsif Suffix (J) = '_' then

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

      end loop;

      if Result then
         Result := Suffix (Suffix'Last) /= '_';
      end if;

      return Result;
   end Is_Identifier_Suffix;

   --------------------
   -- Is_White_Space --
   --------------------

   function Is_White_Space (Ch : Character) return Boolean is
   begin
      return Ch = ' ' or else Ch = ASCII.HT;
   end Is_White_Space;

   -----------------------
   -- String_Hash_Table --
   -----------------------

   package body String_Hash_Table is

      ----------
      -- Hash --
      ----------

      function Hash (Name : String) return Hash_Index_Type is
         subtype Int_1_12 is Int range 1 .. 12;
         --  Used to avoid when others on case jump below

         Even_Name_Len : Integer;
         --  Last even numbered position (used for >12 case)

         --  We take one-to-one the code of the Hash function from Namet
         --  (namet.adb, rev. 1.90). Namet.Hash function works on the name
         --  buffer defined in Namet. We simulate this buffer by defining the
         --  following variables (note converting the argument string to lower
         --  case before computing the hash value):

         Name_Buffer : constant String  := To_Lower (Name);
         --  Note, that out Has function is not case-sensitive!

         Name_Len    : constant Natural := Name_Buffer'Last;
      begin
         --  Special test for 12 (rather than counting on a when others for the
         --  case statement below) avoids some Ada compilers converting the
         --  case statement into successive jumps.

         --  The case of a name longer than 12 characters is handled by taking
         --  the first 6 odd numbered characters and the last 6 even numbered
         --  characters

         if Name_Len > 12 then
            Even_Name_Len := (Name_Len) / 2 * 2;

            return ((((((((((((
              Character'Pos (Name_Buffer (01))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
              Character'Pos (Name_Buffer (03))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
              Character'Pos (Name_Buffer (05))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
              Character'Pos (Name_Buffer (07))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
              Character'Pos (Name_Buffer (09))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
              Character'Pos (Name_Buffer (11))) * 2 +
              Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
         end if;

         --  For the cases of 1-12 characters, all characters participate in
         --  the hash. The positioning is randomized, with the bias that
         --  characters later on participate fully (i.e. are added towards the
         --  right side).

         case Int_1_12 (Name_Len) is
            when 1 =>
               return Character'Pos (Name_Buffer (1));

            when 2 =>
               return ((
                 Character'Pos (Name_Buffer (1))) * 64 +
                 Character'Pos (Name_Buffer (2))) mod Hash_Num;

            when 3 =>
               return (((
                 Character'Pos (Name_Buffer (1))) * 16 +
                 Character'Pos (Name_Buffer (3))) * 16 +
                 Character'Pos (Name_Buffer (2))) mod Hash_Num;

            when 4 =>
               return ((((
                 Character'Pos (Name_Buffer (1))) * 8 +
                 Character'Pos (Name_Buffer (2))) * 8 +
                 Character'Pos (Name_Buffer (3))) * 8 +
                 Character'Pos (Name_Buffer (4))) mod Hash_Num;

            when 5 =>
               return (((((
                 Character'Pos (Name_Buffer (4))) * 8 +
                 Character'Pos (Name_Buffer (1))) * 4 +
                 Character'Pos (Name_Buffer (3))) * 4 +
                 Character'Pos (Name_Buffer (5))) * 8 +
                 Character'Pos (Name_Buffer (2))) mod Hash_Num;

            when 6 =>
               return ((((((
                 Character'Pos (Name_Buffer (5))) * 4 +
                 Character'Pos (Name_Buffer (1))) * 4 +
                 Character'Pos (Name_Buffer (4))) * 4 +
                 Character'Pos (Name_Buffer (2))) * 4 +
                 Character'Pos (Name_Buffer (6))) * 4 +
                 Character'Pos (Name_Buffer (3))) mod Hash_Num;

            when 7 =>
               return (((((((
                 Character'Pos (Name_Buffer (4))) * 4 +
                 Character'Pos (Name_Buffer (3))) * 4 +
                 Character'Pos (Name_Buffer (1))) * 4 +
                 Character'Pos (Name_Buffer (2))) * 2 +
                 Character'Pos (Name_Buffer (5))) * 2 +
                 Character'Pos (Name_Buffer (7))) * 2 +
                 Character'Pos (Name_Buffer (6))) mod Hash_Num;

            when 8 =>
               return ((((((((
                 Character'Pos (Name_Buffer (2))) * 4 +
                 Character'Pos (Name_Buffer (1))) * 4 +
                 Character'Pos (Name_Buffer (3))) * 2 +
                 Character'Pos (Name_Buffer (5))) * 2 +
                 Character'Pos (Name_Buffer (7))) * 2 +
                 Character'Pos (Name_Buffer (6))) * 2 +
                 Character'Pos (Name_Buffer (4))) * 2 +
                 Character'Pos (Name_Buffer (8))) mod Hash_Num;

            when 9 =>
               return (((((((((
                 Character'Pos (Name_Buffer (2))) * 4 +
                 Character'Pos (Name_Buffer (1))) * 4 +
                 Character'Pos (Name_Buffer (3))) * 4 +
                 Character'Pos (Name_Buffer (4))) * 2 +
                 Character'Pos (Name_Buffer (8))) * 2 +
                 Character'Pos (Name_Buffer (7))) * 2 +
                 Character'Pos (Name_Buffer (5))) * 2 +
                 Character'Pos (Name_Buffer (6))) * 2 +
                 Character'Pos (Name_Buffer (9))) mod Hash_Num;

            when 10 =>
               return ((((((((((
                 Character'Pos (Name_Buffer (01))) * 2 +
                 Character'Pos (Name_Buffer (02))) * 2 +
                 Character'Pos (Name_Buffer (08))) * 2 +
                 Character'Pos (Name_Buffer (03))) * 2 +
                 Character'Pos (Name_Buffer (04))) * 2 +
                 Character'Pos (Name_Buffer (09))) * 2 +
                 Character'Pos (Name_Buffer (06))) * 2 +
                 Character'Pos (Name_Buffer (05))) * 2 +
                 Character'Pos (Name_Buffer (07))) * 2 +
                 Character'Pos (Name_Buffer (10))) mod Hash_Num;

            when 11 =>
               return (((((((((((
                 Character'Pos (Name_Buffer (05))) * 2 +
                 Character'Pos (Name_Buffer (01))) * 2 +
                 Character'Pos (Name_Buffer (06))) * 2 +
                 Character'Pos (Name_Buffer (09))) * 2 +
                 Character'Pos (Name_Buffer (07))) * 2 +
                 Character'Pos (Name_Buffer (03))) * 2 +
                 Character'Pos (Name_Buffer (08))) * 2 +
                 Character'Pos (Name_Buffer (02))) * 2 +
                 Character'Pos (Name_Buffer (10))) * 2 +
                 Character'Pos (Name_Buffer (04))) * 2 +
                 Character'Pos (Name_Buffer (11))) mod Hash_Num;

            when 12 =>
               return ((((((((((((
                 Character'Pos (Name_Buffer (03))) * 2 +
                 Character'Pos (Name_Buffer (02))) * 2 +
                 Character'Pos (Name_Buffer (05))) * 2 +
                 Character'Pos (Name_Buffer (01))) * 2 +
                 Character'Pos (Name_Buffer (06))) * 2 +
                 Character'Pos (Name_Buffer (04))) * 2 +
                 Character'Pos (Name_Buffer (08))) * 2 +
                 Character'Pos (Name_Buffer (11))) * 2 +
                 Character'Pos (Name_Buffer (07))) * 2 +
                 Character'Pos (Name_Buffer (09))) * 2 +
                 Character'Pos (Name_Buffer (10))) * 2 +
                 Character'Pos (Name_Buffer (12))) mod Hash_Num;
         end case;
      end Hash;

   end String_Hash_Table;

end ASIS_UL.Misc;
