-------------------------------------------------------------------------------
-- (C) Altran Praxis Limited
-------------------------------------------------------------------------------
--
-- The SPARK toolset 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 3, or (at your option) any later
-- version. The SPARK toolset 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 the SPARK toolset; see file
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy of
-- the license.
--
--=============================================================================

with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Statistics;
with SystemErrors;

package body LexTokenManager
--# own State is String_Table,
--#              The_Last_Token;
is

   type Table_Contents is array (Lex_String) of Character;

   subtype Hash_Index is Natural range 0 .. ExaminerConstants.String_Hash_Size - 1;
   type Hash_Table_Struct is array (Hash_Index) of Lex_String;

   type Table_Structure is record
      Next_Vacant : Lex_String;
      Hash_Table  : Hash_Table_Struct;
      Contents    : Table_Contents;
   end record;

   -- The string table uses hashing with chaining, ie if there is a clash then
   -- the next item is rehashed to a new location and a link is provided to it.
   -- This link occupies the first 3 bytes in each entry (because the max string
   -- table size is 2**21).
   Str_Link_Len : constant Lex_String := 3;

   String_Table   : Table_Structure;
   The_Last_Token : Lex_String;

   function Lex_String_Compare
     (Lex_Str1       : Lex_String;
      Lex_Str2       : Lex_String;
      Case_Sensitive : Boolean)
     return           Str_Comp_Result
   --# global in String_Table;
   is
      Result   : Str_Comp_Result := Str_Eq;
      Finished : Boolean         := False;
      Index1   : Lex_String;
      Index2   : Lex_String;

      function Character_Pos (Index          : Lex_String;
                              Case_Sensitive : Boolean) return Natural
      --# global in String_Table;
      is
         Result : Natural;
      begin
         if Case_Sensitive then
            Result := Character'Pos (String_Table.Contents (Index));
         else
            Result := Character'Pos (Ada.Characters.Handling.To_Upper (String_Table.Contents (Index)));
         end if;
         return Result;
      end Character_Pos;

   begin

      if Lex_Str1 = Lex_Str2 then
         Result := Str_Eq;
      elsif Lex_Str1 /= Null_String and then Lex_Str2 /= Null_String then

         -- This check should never fail, but would need precondition and proof to show this.
         if (Lex_Str1 <= Lex_String'Last - Str_Link_Len and then Lex_Str2 <= Lex_String'Last - Str_Link_Len) then

            Index1 := Lex_Str1 + Str_Link_Len;
            Index2 := Lex_Str2 + Str_Link_Len;

         else
            Index1 := Null_String;
            Index2 := Null_String;
            SystemErrors.Fatal_Error (Sys_Err => SystemErrors.String_Table_Overflow,
                                      Msg     => "Invalid input string.");

         end if;

         while not Finished loop

            -- If we've reached the end of both strings then they are equal
            if (String_Table.Contents (Index1) = Ada.Characters.Latin_1.NUL
                  and then String_Table.Contents (Index2) = Ada.Characters.Latin_1.NUL) then

               Result   := Str_Eq;
               Finished := True;

               -- If the current character in the first string is closer to the start of the
               -- alphabet then the first string is alphabetically first. Note that Ada.Characters.Latin_1.NUL
               -- comes before 'A' so this will return StrFirst if we've reached the end of the
               -- first string but not the second.
            elsif (Character_Pos (Index          => Index1,
                                  Case_Sensitive => Case_Sensitive) <
                     Character_Pos (Index          => Index2,
                                    Case_Sensitive => Case_Sensitive)) then

               Result   := Str_First;
               Finished := True;

               -- Reverse of the previous comparison...
            elsif (Character_Pos (Index          => Index1,
                                  Case_Sensitive => Case_Sensitive) >
                     Character_Pos (Index          => Index2,
                                    Case_Sensitive => Case_Sensitive)) then

               Result   := Str_Second;
               Finished := True;

            else

               -- If we have reached this point and one of the strings has hit the top of the
               -- table without its final char being null then something has gone wrong, but
               -- guard avoids possible RTE.
               if (Index1 < Lex_String'Last and Index2 < Lex_String'Last) then
                  Index1 := Index1 + 1;
                  Index2 := Index2 + 1;
               else
                  SystemErrors.Fatal_Error
                    (Sys_Err => SystemErrors.String_Table_Overflow,
                     Msg     => "Attempt to index past end of table.");
               end if;

            end if;

         end loop;

         -- Deal with the cases where at least one string is null
      elsif Lex_Str1 = Null_String then
         Result := Str_First;
      else
         Result := Str_Second;
      end if;

      return Result;
   end Lex_String_Compare;

   --  Performs case insensitive comparison of two Lex_Strings and
   --  returns which string comes first when ordered alphabetically
   --  (See also Comp_Str_Case_Insensitive and
   --  Comp_Str_Case_Sensitive, below)
   function Lex_String_Case_Insensitive_Compare (Lex_Str1 : Lex_String;
                                                 Lex_Str2 : Lex_String) return Str_Comp_Result
   --# global in String_Table;
   is
   begin
      return Lex_String_Compare (Lex_Str1       => Lex_Str1,
                                 Lex_Str2       => Lex_Str2,
                                 Case_Sensitive => False);
   end Lex_String_Case_Insensitive_Compare;

   --  Performs case sensitive comparison of two Lex_Strings and
   --  returns which string comes first when ordered alphabetically
   --  (See also Comp_Str_Case_Insensitive and
   --  Comp_Str_Case_Sensitive, below)
   function Lex_String_Case_Sensitive_Compare (Lex_Str1 : Lex_String;
                                               Lex_Str2 : Lex_String) return Str_Comp_Result
   --# global in String_Table;
   is
   begin
      return Lex_String_Compare (Lex_Str1       => Lex_Str1,
                                 Lex_Str2       => Lex_Str2,
                                 Case_Sensitive => True);
   end Lex_String_Case_Sensitive_Compare;

   function Comp_Str_Case_Insensitive (Str     : E_Strings.T;
                                       Lex_Str : Lex_String) return Boolean
   --# global in String_Table;
   is
      LX        : Natural;
      SX        : Lex_String;
      Str_Equal : Boolean;
   begin
      if Lex_Str = Null_String and then E_Strings.Is_Empty (E_Str => Str) then
         Str_Equal := True;
      elsif Lex_Str = Null_String and then not E_Strings.Is_Empty (E_Str => Str) then
         Str_Equal := False;
      else
         SX        := Lex_Str + Str_Link_Len;
         Str_Equal := True;
         LX        := 1;
         while Str_Equal and then LX <= E_Strings.Get_Length (E_Str => Str) loop
            if Ada.Characters.Handling.To_Upper (E_Strings.Get_Element (E_Str => Str,
                                                                        Pos   => LX)) =
              Ada.Characters.Handling.To_Upper (String_Table.Contents (SX)) then
               LX := LX + 1;
               SX := SX + 1;
            else
               Str_Equal := False;
            end if;
         end loop;
         if String_Table.Contents (SX) /= Ada.Characters.Latin_1.NUL then
            Str_Equal := False;
         end if;
      end if;
      return Str_Equal;
   end Comp_Str_Case_Insensitive;

   function Comp_Str_Case_Sensitive (Str     : E_Strings.T;
                                     Lex_Str : Lex_String) return Boolean
   --# global in String_Table;
   is
      LX        : Natural;
      SX        : Lex_String;
      Str_Equal : Boolean;
   begin
      if Lex_Str = Null_String and then E_Strings.Is_Empty (E_Str => Str) then
         Str_Equal := True;
      elsif Lex_Str = Null_String and then not E_Strings.Is_Empty (E_Str => Str) then
         Str_Equal := False;
      else
         SX        := Lex_Str + Str_Link_Len;
         Str_Equal := True;
         LX        := 1;
         while Str_Equal and then LX <= E_Strings.Get_Length (E_Str => Str) loop
            if E_Strings.Get_Element (E_Str => Str,
                                      Pos   => LX) = String_Table.Contents (SX) then
               LX := LX + 1;
               SX := SX + 1;
            else
               Str_Equal := False;
            end if;
         end loop;
         if String_Table.Contents (SX) /= Ada.Characters.Latin_1.NUL then
            Str_Equal := False;
         end if;
      end if;
      return Str_Equal;
   end Comp_Str_Case_Sensitive;

   procedure Insert_Examiner_String (Str     : in     E_Strings.T;
                                     Lex_Str :    out Lex_String)
   --# global in out String_Table;
   --# derives Lex_Str,
   --#         String_Table from Str,
   --#                           String_Table;
   is
      Hash_Val                     : Hash_Index;
      Loc_Str, Token_Str, Str_Link : Lex_String;
      Searching                    : Boolean;

      function Hash (Str : E_Strings.T) return Hash_Index is
         Val : Hash_Index;
      begin
         Val := 0;
         for Ix in E_Strings.Positions range 1 .. E_Strings.Get_Length (E_Str => Str) loop
            Val :=
              (Val +
                 Hash_Index (Character'Pos (Ada.Characters.Handling.To_Upper (E_Strings.Get_Element (E_Str => Str,
                                                                                                     Pos   => Ix))))) mod
              ExaminerConstants.String_Hash_Size;
         end loop;
         return Val;
      end Hash;

      procedure Set_Str_Link (Lex_Str, Str_Link : in Lex_String)
      --# global in out String_Table;
      --# derives String_Table from *,
      --#                           Lex_Str,
      --#                           Str_Link;
      is
      begin
         String_Table.Contents (Lex_Str)     := Character'Val (Str_Link / 2 ** 14);
         String_Table.Contents (Lex_Str + 1) := Character'Val ((Str_Link / 2 ** 7) mod 2 ** 7);
         String_Table.Contents (Lex_Str + 2) := Character'Val (Str_Link mod 2 ** 7);
      end Set_Str_Link;

      function Get_Str_Link (Lex_Str : in Lex_String) return Lex_String
      --# global in String_Table;
      is
         Link : Lex_String;
      begin
         Link := Character'Pos (String_Table.Contents (Lex_Str)) * 2 ** 14;
         Link := Link + Character'Pos (String_Table.Contents (Lex_Str + 1)) * 2 ** 7;
         Link := Link + Character'Pos (String_Table.Contents (Lex_Str + 2));
         return Link;
      end Get_Str_Link;

      procedure Copy_Str (Str     : in     E_Strings.T;
                          Lex_Str :    out Lex_String)
      --# global in out String_Table;
      --# derives Lex_Str,
      --#         String_Table from Str,
      --#                           String_Table;
      is
         SX : Lex_String;
      begin
         if String_Table.Next_Vacant = Null_String
           or else ((String_Table.Next_Vacant + Str_Link_Len) + Lex_String (E_Strings.Get_Length (E_Str => Str))) + 1 >
           Lex_String'Last then
            Lex_Str := Null_String;
         else
            -- There is space for link, string and string terminator
            SX      := String_Table.Next_Vacant;
            Lex_Str := SX;
            Set_Str_Link (Lex_Str  => SX,
                          Str_Link => Null_String);
            SX := SX + Str_Link_Len; -- Skip StringLink.
            for LX in E_Strings.Positions range 1 .. E_Strings.Get_Length (E_Str => Str) loop
               String_Table.Contents (SX) := E_Strings.Get_Element (E_Str => Str,
                                                                    Pos   => LX);
               SX                         := SX + 1;
            end loop;
            String_Table.Contents (SX) := Ada.Characters.Latin_1.NUL;  -- Lex_String Terminator.
            if SX = Lex_String'Last then
               String_Table.Next_Vacant := Null_String;
            else
               String_Table.Next_Vacant := SX + 1;
            end if;
         end if;
      end Copy_Str;

   begin
      Token_Str := Null_String;
      Hash_Val  := Hash (Str => Str);
      Loc_Str   := String_Table.Hash_Table (Hash_Val);
      if Loc_Str = Null_String then  -- No string elements at this entry.
         Copy_Str (Str     => Str,
                   Lex_Str => Token_Str);
         String_Table.Hash_Table (Hash_Val) := Token_Str;
         -- String element now exists at this Hash_Table entry.
      else
         Searching := True;

         while Searching loop
            if Comp_Str_Case_Sensitive (Str     => Str,
                                        Lex_Str => Loc_Str) then
               Token_Str := Loc_Str;
               Searching := False;
            else
               Str_Link := Get_Str_Link (Lex_Str => Loc_Str);
               if Str_Link = Null_String then
                  Copy_Str (Str     => Str,
                            Lex_Str => Token_Str);
                  Set_Str_Link (Lex_Str  => Loc_Str,
                                Str_Link => Token_Str);
                  Searching := False;
               else
                  Loc_Str := Str_Link;
               end if;
            end if;
         end loop;
      end if;
      if Token_Str = Null_String then
         SystemErrors.Fatal_Error (Sys_Err => SystemErrors.String_Table_Overflow,
                                   Msg     => "");
      end if;
      Lex_Str := Token_Str;
   end Insert_Examiner_String;

   function Lex_String_To_String (Lex_Str : Lex_String) return E_Strings.T
   --# global in String_Table;
   is
      IX  : Lex_String;
      CH  : Character;
      Str : E_Strings.T := E_Strings.Empty_String;
   begin
      if Lex_Str /= Null_String then
         IX := Lex_Str + Str_Link_Len;
         loop
            CH := String_Table.Contents (IX);
            exit when CH = Ada.Characters.Latin_1.NUL;  -- Lex_String Terminator.
            E_Strings.Append_Char (E_Str => Str,
                                   Ch    => CH);
            IX := IX + 1;
         end loop;
      end if;
      return Str;
   end Lex_String_To_String;

   function Is_Attribute_Token (Tok      : Lex_String;
                                Language : CommandLineData.Language_Profiles) return Boolean
   --# global in String_Table;
   is
      type Index is (
                     Aft_Token_Entry,
                     Base_Token_Entry,
                     Delta_Token_Entry,
                     Digits_Token_Entry,
                     Emax_Token_Entry,
                     Epsilon_Token_Entry,
                     First_Token_Entry,
                     Fore_Token_Entry,
                     Large_Token_Entry,
                     Last_Token_Entry,
                     Length_Token_Entry,
                     Machine_Emax_Token_Entry,
                     Machine_Emin_Token_Entry,
                     Machine_Mantissa_Token_Entry,
                     Machine_Overflows_Token_Entry,
                     Machine_Radix_Token_Entry,
                     Machine_Rounds_Token_Entry,
                     Mantissa_Token_Entry,
                     Pos_Token_Entry,
                     Pred_Token_Entry,
                     Range_Token_Entry,
                     Safe_Emax_Token_Entry,
                     Safe_Large_Token_Entry,
                     Safe_Small_Token_Entry,
                     Size_Token_Entry,
                     Small_Token_Entry,
                     Succ_Token_Entry,
                     Val_Token_Entry,
                     Denorm_Token_Entry,
                     Model_Emin_Token_Entry,
                     Model_Epsilon_Token_Entry,
                     Model_Mantissa_Token_Entry,
                     Model_Small_Token_Entry,
                     Safe_First_Token_Entry,
                     Safe_Last_Token_Entry,
                     Component_Size_Token_Entry,
                     Min_Token_Entry,
                     Max_Token_Entry,
                     Signed_Zeros_Token_Entry,
                     Valid_Token_Entry,
                     Adjacent_Token_Entry,
                     Compose_Token_Entry,
                     Copy_Sign_Token_Entry,
                     Leading_Part_Token_Entry,
                     Remainder_Token_Entry,
                     Scaling_Token_Entry,
                     Ceiling_Token_Entry,
                     Exponent_Token_Entry,
                     Floor_Token_Entry,
                     Fraction_Token_Entry,
                     Machine_Token_Entry,
                     Model_Token_Entry,
                     Rounding_Token_Entry,
                     Truncation_Token_Entry,
                     Unbiased_Rounding_Token_Entry,
                     Address_Token_Entry,
                     Modulus_Token_Entry,
                     Tail_Token_Entry,
                     Append_Token_Entry,
                     Access_Token_Entry,
                     Always_Valid_Token_Entry,
                     Mod_Token_Entry,
                     Machine_Rounding_Token_Entry);

      type Language_Array is array (CommandLineData.Language_Profiles) of Boolean;

      type Tables_Element is record
         Token    : Lex_String;
         Language : Language_Array;
      end record;

      type Tables is array (Index) of Tables_Element;

      ------------------------------------------------------------------
      -- This table defines the sets of attributes that are defined
      -- in SPARK83, SPARK95, and SPARK2005 modes.
      --
      -- Seven floating-point and fixed-point attributes are considered
      -- obsolete but remain as implementation-defined attributes
      -- in SPARK95 and 2005 modes, following the advice of AARM A.5.3 (72.f)
      -- and A.5.4 (4.b)
      ------------------------------------------------------------------
      Attribute_Table : constant Tables :=
        Tables'
        (Aft_Token_Entry               => Tables_Element'(Token    => Aft_Token,
                                                          Language => Language_Array'(others => True)),
         Base_Token_Entry              => Tables_Element'(Token    => Base_Token,
                                                          Language => Language_Array'(others => True)),
         Delta_Token_Entry             => Tables_Element'(Token    => Delta_Token,
                                                          Language => Language_Array'(others => True)),
         Digits_Token_Entry            => Tables_Element'(Token    => Digits_Token,
                                                          Language => Language_Array'(others => True)),
         Emax_Token_Entry              => Tables_Element'(Token    => Emax_Token,
                                                          Language => Language_Array'(others => True)),
         Epsilon_Token_Entry           => Tables_Element'(Token    => Epsilon_Token,
                                                          Language => Language_Array'(others => True)),
         First_Token_Entry             => Tables_Element'(Token    => First_Token,
                                                          Language => Language_Array'(others => True)),
         Fore_Token_Entry              => Tables_Element'(Token    => Fore_Token,
                                                          Language => Language_Array'(others => True)),
         Large_Token_Entry             => Tables_Element'(Token    => Large_Token,
                                                          Language => Language_Array'(others => True)),
         Last_Token_Entry              => Tables_Element'(Token    => Last_Token,
                                                          Language => Language_Array'(others => True)),
         Length_Token_Entry            => Tables_Element'(Token    => Length_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Emax_Token_Entry      => Tables_Element'(Token    => Machine_Emax_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Emin_Token_Entry      => Tables_Element'(Token    => Machine_Emin_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Mantissa_Token_Entry  => Tables_Element'(Token    => Machine_Mantissa_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Overflows_Token_Entry => Tables_Element'(Token    => Machine_Overflows_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Radix_Token_Entry     => Tables_Element'(Token    => Machine_Radix_Token,
                                                          Language => Language_Array'(others => True)),
         Machine_Rounds_Token_Entry    => Tables_Element'(Token    => Machine_Rounds_Token,
                                                          Language => Language_Array'(others => True)),
         Mantissa_Token_Entry          => Tables_Element'(Token    => Mantissa_Token,
                                                          Language => Language_Array'(others => True)),
         Pos_Token_Entry               => Tables_Element'(Token    => Pos_Token,
                                                          Language => Language_Array'(others => True)),
         Pred_Token_Entry              => Tables_Element'(Token    => Pred_Token,
                                                          Language => Language_Array'(others => True)),
         Range_Token_Entry             => Tables_Element'(Token    => Range_Token,
                                                          Language => Language_Array'(others => True)),
         Safe_Emax_Token_Entry         => Tables_Element'(Token    => Safe_Emax_Token,
                                                          Language => Language_Array'(others => True)),
         Safe_Large_Token_Entry        => Tables_Element'(Token    => Safe_Large_Token,
                                                          Language => Language_Array'(others => True)),
         Safe_Small_Token_Entry        => Tables_Element'(Token    => Safe_Small_Token,
                                                          Language => Language_Array'(others => True)),
         Size_Token_Entry              => Tables_Element'(Token    => Size_Token,
                                                          Language => Language_Array'(others => True)),
         Small_Token_Entry             => Tables_Element'(Token    => Small_Token,
                                                          Language => Language_Array'(others => True)),
         Succ_Token_Entry              => Tables_Element'(Token    => Succ_Token,
                                                          Language => Language_Array'(others => True)),
         Val_Token_Entry               => Tables_Element'(Token    => Val_Token,
                                                          Language => Language_Array'(others => True)),
         Denorm_Token_Entry            => Tables_Element'(Token    => Denorm_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Model_Emin_Token_Entry        => Tables_Element'(Token    => Model_Emin_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Model_Epsilon_Token_Entry     => Tables_Element'(Token    => Model_Epsilon_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Model_Mantissa_Token_Entry    => Tables_Element'(Token    => Model_Mantissa_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Model_Small_Token_Entry       => Tables_Element'(Token    => Model_Small_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Safe_First_Token_Entry        => Tables_Element'(Token    => Safe_First_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Safe_Last_Token_Entry         => Tables_Element'(Token    => Safe_Last_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Component_Size_Token_Entry    => Tables_Element'(Token    => Component_Size_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Min_Token_Entry               => Tables_Element'(Token    => Min_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Max_Token_Entry               => Tables_Element'(Token    => Max_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Signed_Zeros_Token_Entry      => Tables_Element'(Token    => Signed_Zeros_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Valid_Token_Entry             => Tables_Element'(Token    => Valid_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Adjacent_Token_Entry          => Tables_Element'(Token    => Adjacent_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Compose_Token_Entry           => Tables_Element'(Token    => Compose_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Copy_Sign_Token_Entry         => Tables_Element'(Token    => Copy_Sign_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Leading_Part_Token_Entry      => Tables_Element'(Token    => Leading_Part_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Remainder_Token_Entry         => Tables_Element'(Token    => Remainder_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Scaling_Token_Entry           => Tables_Element'(Token    => Scaling_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Ceiling_Token_Entry           => Tables_Element'(Token    => Ceiling_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Exponent_Token_Entry          => Tables_Element'(Token    => Exponent_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Floor_Token_Entry             => Tables_Element'(Token    => Floor_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Fraction_Token_Entry          => Tables_Element'(Token    => Fraction_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Machine_Token_Entry           => Tables_Element'(Token    => Machine_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Model_Token_Entry             => Tables_Element'(Token    => Model_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Rounding_Token_Entry          => Tables_Element'(Token    => Rounding_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Truncation_Token_Entry        => Tables_Element'(Token    => Truncation_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Unbiased_Rounding_Token_Entry => Tables_Element'(Token    => Unbiased_Rounding_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Address_Token_Entry           => Tables_Element'(Token    => Address_Token,
                                                          Language => Language_Array'(others => False)),
         Modulus_Token_Entry           => Tables_Element'(Token    => Modulus_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Tail_Token_Entry              => Tables_Element'(Token    => Tail_Token,
                                                          Language => Language_Array'(others => True)),
         Append_Token_Entry            => Tables_Element'(Token    => Append_Token,
                                                          Language => Language_Array'(others => True)),
         Access_Token_Entry            => Tables_Element'(Token    => Access_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK83 => False,
                                                                                      others                  => True)),
         Always_Valid_Token_Entry      => Tables_Element'(Token    => Always_Valid_Token,
                                                          Language => Language_Array'(others => True)),
         Mod_Token_Entry               => Tables_Element'(Token    => Mod_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK2005_Profiles => True,
                                                                                      others                             => False)),
         Machine_Rounding_Token_Entry  => Tables_Element'(Token    => Machine_Rounding_Token,
                                                          Language => Language_Array'(CommandLineData.SPARK2005_Profiles => True,
                                                                                      others                             => False)));

      Result : Boolean := False;

   begin -- Is_Attribute_Token
      for I in Index loop
         if Lex_String_Case_Insensitive_Compare (Lex_Str1 => Attribute_Table (I).Token,
                                                 Lex_Str2 => Tok) = Str_Eq then
            Result := Attribute_Table (I).Language (Language);
            exit;
         end if;
      end loop;
      return Result;
   end Is_Attribute_Token;

   procedure Initialise_String_Table
   --# global in out String_Table;
   --# derives String_Table from *;
   is

      -----------------------------------------------------------
      -- This procedure inserts the given String into the String
      -- table and checks that the new Lex_String returned is as
      -- expected.  We use type String here so that callers may
      -- pass a string literal.
      -----------------------------------------------------------
      procedure Ins (Str          : in String;
                     Expected_Str : in Lex_String)
      --# global in out String_Table;
      --# derives String_Table from *,
      --#                           Str &
      --#         null         from Expected_Str;
      is
         New_Str : Lex_String;
      begin
         Insert_Examiner_String (Str     => E_Strings.Copy_String (Str => Str),
                                 Lex_Str => New_Str);
         if New_Str /= Expected_Str then
            SystemErrors.Fatal_Error
              (Sys_Err => SystemErrors.Invalid_Init,
               Msg     => "Initialise_String_Table : New_Str /= Expected_Str");
         end if;
      end Ins;

   begin
      Ins ("Aft", Aft_Token);
      Ins ("Base", Base_Token);
      Ins ("delta", Delta_Token);
      Ins ("digits", Digits_Token);
      Ins ("Emax", Emax_Token);
      Ins ("Epsilon", Epsilon_Token);
      Ins ("First", First_Token);
      Ins ("Fore", Fore_Token);
      Ins ("Large", Large_Token);
      Ins ("Last", Last_Token);

      --# assert True;

      Ins ("Length", Length_Token);
      Ins ("Machine_Emax", Machine_Emax_Token);
      Ins ("Machine_Emin", Machine_Emin_Token);
      Ins ("Machine_Mantissa", Machine_Mantissa_Token);
      Ins ("Machine_Overflows", Machine_Overflows_Token);
      Ins ("Machine_Radix", Machine_Radix_Token);
      Ins ("Machine_Rounds", Machine_Rounds_Token);
      Ins ("Mantissa", Mantissa_Token);
      Ins ("Pos", Pos_Token);
      Ins ("Pred", Pred_Token);

      --# assert True;

      Ins ("Range", Range_Token);
      Ins ("Safe_Emax", Safe_Emax_Token);
      Ins ("Safe_Large", Safe_Large_Token);
      Ins ("Safe_Small", Safe_Small_Token);
      Ins ("Size", Size_Token);
      Ins ("Small", Small_Token);
      Ins ("Succ", Succ_Token);
      Ins ("Val", Val_Token);
      Ins ("Left", Left_Token);
      Ins ("Right", Right_Token);

      --# assert True;

      Ins ("True", True_Token);
      Ins ("False", False_Token);
      Ins ("0", Zero_Value);
      Ins ("1", One_Value);
      Ins ("superindex", Super_Index_Token);
      Ins ("Interface", Interface_Token);
      Ins ("Import", Import_Token);
      Ins ("Link_Name", Link_Name_Token);
      Ins ("External_Name", External_Name_Token);
      Ins ("Entity", Entity_Token);

      --# assert True;

      Ins ("Convention", Convention_Token);
      Ins ("Elaborate_Body", Elaborate_Body_Token);
      Ins ("Ada", Ada_Token);
      Ins ("SPARK", SPARK_Token);
      Ins ("Denorm", Denorm_Token);
      Ins ("Model_Emin", Model_Emin_Token);
      Ins ("Model_Epsilon", Model_Epsilon_Token);
      Ins ("Model_Mantissa", Model_Mantissa_Token);
      Ins ("Model_Small", Model_Small_Token);
      Ins ("Safe_First", Safe_First_Token);
      Ins ("Safe_Last", Safe_Last_Token);

      --# assert True;

      Ins ("Component_Size", Component_Size_Token);
      Ins ("Min", Min_Token);
      Ins ("Max", Max_Token);
      Ins ("Signed_Zeros", Signed_Zeros_Token);
      Ins ("Valid", Valid_Token);
      Ins ("Characters", Characters_Token);
      Ins ("Latin_1", Latin_1_Token);
      Ins ("Adjacent", Adjacent_Token);
      Ins ("Compose", Compose_Token);
      Ins ("Copy_Sign", Copy_Sign_Token);

      --# assert True;

      Ins ("Leading_Part", Leading_Part_Token);
      Ins ("Remainder", Remainder_Token);
      Ins ("Scaling", Scaling_Token);
      Ins ("Ceiling", Ceiling_Token);
      Ins ("Exponent", Exponent_Token);
      Ins ("Floor", Floor_Token);
      Ins ("Fraction", Fraction_Token);
      Ins ("Machine", Machine_Token);
      Ins ("Model", Model_Token);
      Ins ("Rounding", Rounding_Token);

      --# assert True;

      Ins ("Truncation", Truncation_Token);
      Ins ("Unbiased_Rounding", Unbiased_Rounding_Token);
      Ins ("Address", Address_Token);
      Ins ("Modulus", Modulus_Token);
      Ins ("Tail", Tail_Token);
      Ins ("Append", Append_Token);
      Ins ("System", System_Token);
      Ins ("Min_Int", Min_Int_Token);
      Ins ("Max_Int", Max_Int_Token);
      Ins ("Max_Binary_Modulus", Max_Binary_Modulus_Token);

      --# assert True;

      Ins ("Max_Base_Digits", Max_Base_Digits_Token);
      Ins ("Max_Digits", Max_Digits_Token);
      Ins ("Max_Mantissa", Max_Mantissa_Token);
      Ins ("Fine_Delta", Fine_Delta_Token);
      Ins ("Null_Address", Null_Address_Token);
      Ins ("Storage_Unit", Storage_Unit_Token);
      Ins ("Word_Size", Word_Size_Token);
      Ins ("Any_Priority", Any_Priority_Token);
      Ins ("Priority", Priority_Token);
      Ins ("Interrupt_Priority", Interrupt_Priority_Token);

      --# assert True;

      Ins ("Default_Priority", Default_Priority_Token);
      Ins ("Atomic", Atomic_Token);
      Ins ("Real_Time", Real_Time_Token);
      Ins ("inherit", Inherit_Token);
      Ins ("Synchronous_Task_Control", Synchronous_Task_Control_Token);
      Ins ("Attach_Handler", Attach_Handler_Token);
      Ins ("Interrupt_Handler", Interrupt_Handler_Token);
      Ins ("Interrupts", Interrupts_Token);
      Ins ("Access", Access_Token);
      Ins ("Atomic_Components", Atomic_Components_Token);

      --# assert True;

      Ins ("Volatile_Components", Volatile_Components_Token);
      Ins ("main_program", Main_Program_Token);
      Ins ("assert", Assert_Token);
      Ins ("overriding", Overriding_Token);
      Ins ("Unchecked_Conversion", Unchecked_Conversion_Token);
      Ins ("Rule", Rule_Token);
      Ins ("NoRule", No_Rule_Token);
      Ins ("Always_Valid", Always_Valid_Token);

      --# assert True;

      Ins ("Bit_Order", Bit_Order_Token);
      Ins ("High_Order_First", High_Order_First_Token);
      Ins ("Low_Order_First", Low_Order_First_Token);
      Ins ("Default_Bit_Order", Default_Bit_Order_Token);

      --# assert True;

      Ins ("All_Calls_Remote", All_Calls_Remote_Token);
      Ins ("Asynchronous", Asynchronous_Token);
      Ins ("Controlled", Controlled_Token);
      Ins ("Discard_Names", Discard_Names_Token);
      Ins ("Elaborate", Elaborate_Token);
      Ins ("Elaborate_All", Elaborate_All_Token);
      Ins ("Export", Export_Token);
      Ins ("Inline", Inline_Token);
      Ins ("Inspection_Point", Inspection_Point_Token);
      Ins ("Linker_Options", Linker_Options_Token);
      Ins ("List", List_Token);
      Ins ("Locking_Policy", Locking_Policy_Token);
      Ins ("Normalize_Scalars", Normalize_Scalars_Token);
      Ins ("Optimize", Optimize_Token);
      Ins ("Pack", Pack_Token);
      Ins ("Page", Page_Token);
      Ins ("Preelaborate", Preelaborate_Token);
      Ins ("Pure", Pure_Token);
      Ins ("Queueing_Policy", Queueing_Policy_Token);
      Ins ("Remote_Call_Interface", Remote_Call_Interface_Token);
      Ins ("Remote_Types", Remote_Types_Token);
      Ins ("Restrictions", Restrictions_Token);
      Ins ("Reviewable", Reviewable_Token);
      Ins ("Shared_Passive", Shared_Passive_Token);
      Ins ("Storage_Size", Storage_Size_Token);
      Ins ("Suppress", Suppress_Token);
      Ins ("Task_Dispatching_Policy", Task_Dispatching_Policy_Token);
      Ins ("Volatile", Volatile_Token);

      --# assert True;

      Ins ("Memory_Size", Memory_Size_Token);
      Ins ("Shared", Shared_Token);
      Ins ("System_Name", System_Name_Token);

      -- Ada2005
      Ins ("Mod", Mod_Token);
      Ins ("Machine_Rounding", Machine_Rounding_Token);

      Ins ("Priority_Last", Priority_Last_Token);
      Ins ("Standard", Standard_Token);
      Ins ("Integer", Integer_Token);
      Ins ("Float", Float_Token);
      Ins ("Seconds_Count", Seconds_Count_Token);
      Ins ("Interrupt_ID", Interrupt_ID_Token);

      -- Dictionary types
      Ins ("Universal_Integer", Universal_Integer_Token);
      Ins ("Universal_Real", Universal_Real_Token);
      Ins ("Universal_Fixed", Universal_Fixed_Token);
      Ins ("Character", Character_Token);
      Ins ("Boolean", Boolean_Token);
      Ins ("Duration", Duration_Token);
      Ins ("String", String_Token);
      Ins ("Natural", Natural_Token);
      Ins ("Positive", Positive_Token);
      Ins ("Interfaces", Interfaces_Token);

      --------------------------------------------------------------
      -- Insert new lex strings here
      -- Remember to adjust Next_Vacant_Token in lextokenmanager.ads
      --------------------------------------------------------------

      if Next_Vacant_Token /= String_Table.Next_Vacant then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Invalid_Init,
            Msg     => "Initialise_String_Table : Bad value for Next_Vacant_Token");
      end if;

   end Initialise_String_Table;

   procedure Report_Usage
   --# global in     String_Table;
   --#        in out Statistics.TableUsage;
   --# derives Statistics.TableUsage from *,
   --#                                    String_Table;
   is
   begin
      -- table fills from bottom up with no reclamation, so Next_Vacant indicates
      -- the amount of space used
      Statistics.SetTableUsage (Statistics.StringTable, Integer (String_Table.Next_Vacant - 1));
   end Report_Usage;

   procedure Insert_Nat (N       : in     Natural;
                         Lex_Str :    out Lex_String)
   --# global in out String_Table;
   --# derives Lex_Str,
   --#         String_Table from N,
   --#                           String_Table;
      is separate;

   function Is_Standard_Token (Lex_Str : Lex_String) return Boolean
   --# global in The_Last_Token;
   is
   begin
      return Lex_Str <= The_Last_Token;
   end Is_Standard_Token;

   procedure Set_Last_Token
   --# global in     String_Table;
   --#        in out The_Last_Token;
   --# derives The_Last_Token from *,
   --#                             String_Table;
   is
   begin
      if The_Last_Token /= Next_Vacant_Token then
         SystemErrors.Fatal_Error
           (Sys_Err => SystemErrors.Other_Internal_Error,
            Msg     => "LEXTOKENMANAGER.SET_LAST_TOKEN : THE_LAST_TOKEN ALREADY INITIALISED");
      else
         The_Last_Token := String_Table.Next_Vacant - 1;
         while String_Table.Contents (The_Last_Token - 1) /= Ada.Characters.Latin_1.NUL loop
            The_Last_Token := The_Last_Token - 1;
         end loop;
      end if;
   end Set_Last_Token;

begin
   String_Table.Next_Vacant := 1;
   String_Table.Hash_Table  := Hash_Table_Struct'(others => Null_String);
   String_Table.Contents    := Table_Contents'(others => Ada.Characters.Latin_1.NUL);
   The_Last_Token           := Next_Vacant_Token;
end LexTokenManager;
