-------------------------------------------------------------------------------
-- (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.
--
--=============================================================================

-- This procedure breaks a SPARK literal string down into its constituent parts for
-- further processing
separate (Maths)
procedure ParseString
  (S                                               : in     E_Strings.T;
   Decimal_Point_Found, Exponent_Found, Base_Found :    out Boolean;
   Base                                            :    out Natural;
   Core_String, Exp_String                         :    out E_Strings.T;
   Exp_Sign                                        :    out Character;
   Places_After_Point                              :    out E_Strings.Lengths;
   Legal_Syntax                                    :    out Boolean)

-- # derives Decimal_Point_Found from S &
-- #         Exponent_Found     from S &
-- #         Base_Found         from S &
-- #         Base              from S &
-- #         Core_String        from S &
-- #         Exp_String         from S &
-- #         Exp_Sign           from S &
-- #         Places_After_Point  from S &
-- #         Legal_Syntax       from S;

-- NOTES
--   Base_String will be set to "10" if Base_Found = FALSE
--   Exp_String is "0" if Exp_Found = FALSE
--   Exp_Sign is plus if Exp_Found = FALSE
--   Places_Afer_Point is 0 if Decimal_Point_Found = FALSE
--   Legal_Syntax only implies that string looks like an Ada literal

is

   End_Indicator : constant Character := Character'Val (0);

   type Char_Set is array (Character) of Boolean;
   type Parser_State is (
                         Initial,
                         Leading_Zero,
                         Leading_Underline,
                         Later_Digits,
                         Base_Start,
                         Based_Part,
                         End_Base,
                         Decimal_Start,
                         Decimal_Part,
                         Exp_Start,
                         Exp_Part,
                         Finished);

   Syntax_OK                         : Boolean;
   State                             : Parser_State;
   Acceptable, Legal_Digit           : Char_Set;
   Digits_Read, Places_Count, In_Ptr : E_Strings.Lengths;
   Ch                                : Character;
   Buffer                            : E_Strings.T;

   -----------------------------------------------

   procedure Caps (Ch : in out Character)
   --converts Characters a through f to upper case
   --# derives Ch from *;

   is
   begin
      if (Ch >= 'a') and (Ch <= 'f') then
         Ch := Character'Val ((Character'Pos (Ch) - Character'Pos ('a')) + Character'Pos ('A'));
      end if;
   end Caps;

   -----------------------------------------------

   procedure Store (Ch : in Character)
   --# global in out Buffer;
   --# derives Buffer from *,
   --#                     Ch;
   is
   begin
      E_Strings.Append_Char (E_Str => Buffer,
                             Ch    => Ch);
   end Store;

   -----------------------------------------------

   function Legal_Underline (OK : Char_Set) return Boolean
   --# global in In_Ptr;
   --#        in S;
   is
      Ch        : Character;
      OK_So_Far : Boolean;
   begin
      OK_So_Far := In_Ptr < E_Strings.Get_Length (E_Str => S);
      if OK_So_Far then
         Ch := E_Strings.Get_Element (E_Str => S,
                                      Pos   => In_Ptr + 1);
         Caps (Ch => Ch);
         OK_So_Far := OK (Ch);
      end if;
      return OK_So_Far;
   end Legal_Underline;

   -----------------------------------------------

   procedure Calc_Base
   --# global in     Buffer;
   --#        in out Syntax_OK;
   --#           out Base;
   --#           out Legal_Digit;
   --# derives Base,
   --#         Legal_Digit from Buffer &
   --#         Syntax_OK   from *,
   --#                          Buffer;
   is
      Local_Base, I : Natural;
   begin
      if E_Strings.Get_Length (E_Str => Buffer) = 2 then
         Local_Base := 10 * Natural (CharToDigit (E_Strings.Get_Element (E_Str => Buffer,
                                                                         Pos   => 1))) +
           Natural (CharToDigit (E_Strings.Get_Element (E_Str => Buffer,
                                                        Pos   => 2)));
      else -- must be 1
         Local_Base := Natural (CharToDigit (E_Strings.Get_Element (E_Str => Buffer,
                                                                    Pos   => 1)));
      end if;

      Base := Local_Base;

      Legal_Digit := Char_Set'(Character => False);
      I           := 0;
      while I < Local_Base loop
         if I <= 9 then
            Legal_Digit (Character'Val (I + Character'Pos ('0')))   := True;
         else
            Legal_Digit (Character'Val ((I + Character'Pos ('A')) - 10))     := True;
         end if;
         I := I + 1;
      end loop;

      if (Local_Base < 2) or (Local_Base > 16) then
         Syntax_OK := False;
      end if;
   end Calc_Base;

   -----------------------------------------------

   procedure Do_Initial
   --# global in     Ch;
   --#        in out Buffer;
   --#        in out Digits_Read;
   --#           out Acceptable;
   --#           out State;
   --# derives Acceptable,
   --#         State       from Ch &
   --#         Buffer,
   --#         Digits_Read from *,
   --#                          Ch;
   is
   begin
      if Ch = '0' then
         Acceptable := Char_Set'(End_Indicator => True,
                                 '0' .. '9'    => True,
                                 '_'           => True,
                                 '.'           => True,
                                 others        => False);
         State      := Leading_Zero;
      else --must be '1'..'9'
         Store (Ch => Ch);
         Digits_Read := Digits_Read + 1;
         Acceptable  :=
           Char_Set'
           (End_Indicator => True,
            '0' .. '9'    => True,
            '_'           => True,
            '#'           => True,
            '.'           => True,
            'E'           => True,
            others        => False);
         State       := Later_Digits;
      end if;
   end Do_Initial;

   -----------------------------------------------

   procedure Do_Leading_Zero
   --# global in     Ch;
   --#        in out Acceptable;
   --#        in out Buffer;
   --#        in out Core_String;
   --#        in out Digits_Read;
   --#        in out State;
   --# derives Acceptable,
   --#         Buffer,
   --#         Core_String,
   --#         Digits_Read,
   --#         State       from *,
   --#                          Ch;
   is
   begin
      if Ch = '_' then
         Acceptable := Char_Set'('0' .. '9' => True, others => False);
         State      := Leading_Underline;
      elsif Ch = '.' then
         Acceptable := Char_Set'('0' .. '9' => True, others => False);
         State      := Decimal_Start;
      elsif (Ch >= '1') and (Ch <= '9') then
         Store (Ch => Ch);
         Digits_Read := Digits_Read + 1;
         Acceptable  :=
           Char_Set'
           (End_Indicator => True,
            '0' .. '9'    => True,
            '_'           => True,
            '#'           => True,
            '.'           => True,
            'E'           => True,
            others        => False);
         State       := Later_Digits;
      elsif Ch = End_Indicator then
         Core_String := E_Strings.Empty_String;
         E_Strings.Append_Char (E_Str => Core_String,
                                Ch    => '0');
         State := Finished;

         --else its another leading zero and state remains unchanged
      end if;
   end Do_Leading_Zero;

   -----------------------------------------------

   procedure Do_Leading_Underline
   --# global in     Ch;
   --#        in out Buffer;
   --#        in out Digits_Read;
   --#           out Acceptable;
   --#           out State;
   --# derives Acceptable,
   --#         State       from Ch &
   --#         Buffer,
   --#         Digits_Read from *,
   --#                          Ch;
   is
   begin
      if (Ch >= '1') and (Ch <= '9') then
         Store (Ch => Ch);
         Digits_Read := Digits_Read + 1;
         Acceptable  :=
           Char_Set'
           (End_Indicator => True,
            '0' .. '9'    => True,
            '_'           => True,
            '#'           => True,
            '.'           => True,
            'E'           => True,
            others        => False);
         State       := Later_Digits;
      else -- must be '0'
         Acceptable := Char_Set'(End_Indicator => True,
                                 '0' .. '9'    => True,
                                 '_'           => True,
                                 '.'           => True,
                                 others        => False);
         State      := Leading_Zero;
      end if;
   end Do_Leading_Underline;

   -----------------------------------------------

   procedure Do_Later_Digits
   --# global in     Ch;
   --#        in     In_Ptr;
   --#        in     S;
   --#        in out Acceptable;
   --#        in out Base;
   --#        in out Base_Found;
   --#        in out Buffer;
   --#        in out Core_String;
   --#        in out Digits_Read;
   --#        in out Legal_Digit;
   --#        in out State;
   --#        in out Syntax_OK;
   --# derives Acceptable,
   --#         Buffer      from *,
   --#                          Buffer,
   --#                          Ch,
   --#                          Digits_Read &
   --#         Base,
   --#         Core_String,
   --#         Legal_Digit from *,
   --#                          Buffer,
   --#                          Ch &
   --#         Base_Found,
   --#         Digits_Read,
   --#         State       from *,
   --#                          Ch &
   --#         Syntax_OK   from *,
   --#                          Buffer,
   --#                          Ch,
   --#                          In_Ptr,
   --#                          S;
   is
   begin
      case Ch is
         when End_Indicator =>
            Core_String := Buffer;
            State       := Finished;

         when '0' .. '9' => ---------------------------------------------------
            if Digits_Read < 3 then
               Digits_Read := Digits_Read + 1;
               Store (Ch => Ch);
            else
               Acceptable ('#') := False;
               Store (Ch => Ch);
            end if;

         when '.' => ---------------------------------------------------
            Acceptable := Char_Set'('0' .. '9' => True, others => False);
            State      := Decimal_Start;

         when 'E' => ---------------------------------------------------
            Core_String := Buffer;
            Buffer      := E_Strings.Empty_String;
            Acceptable  := Char_Set'('+' => True, '0' .. '9' => True, others => False);
            State       := Exp_Start;

         when '_' => ---------------------------------------------------
            Syntax_OK := Legal_Underline (OK => Char_Set'('0' .. '9' => True, others => False));

         when '#' => ---------------------------------------------------
            Base_Found := True;
            Calc_Base;                 -- also calcs Legal_Digit set
            Buffer     := E_Strings.Empty_String;
            Acceptable := Legal_Digit;
            State      := Base_Start;

         when others => ---------------------------------------------------
            null; -- can't occur
      end case;
   end Do_Later_Digits;

   -----------------------------------------------

   procedure Do_Base_Start
   --# global in     Ch;
   --#        in out Acceptable;
   --#        in out Buffer;
   --#           out State;
   --# derives Acceptable from * &
   --#         Buffer     from *,
   --#                         Ch &
   --#         State      from ;
   is
   begin
      Store (Ch => Ch);                  --which must be an acceptable digit
      Acceptable ('#') := True;
      Acceptable ('_') := True;
      State            := Based_Part;
   end Do_Base_Start;

   -----------------------------------------------

   procedure Do_Based_Part
   --# global in     Ch;
   --#        in     In_Ptr;
   --#        in     Legal_Digit;
   --#        in     S;
   --#        in out Acceptable;
   --#        in out Buffer;
   --#        in out Core_String;
   --#        in out State;
   --#        in out Syntax_OK;
   --# derives Acceptable,
   --#         Buffer,
   --#         State       from *,
   --#                          Ch &
   --#         Core_String from *,
   --#                          Buffer,
   --#                          Ch &
   --#         Syntax_OK   from *,
   --#                          Ch,
   --#                          In_Ptr,
   --#                          Legal_Digit,
   --#                          S;
   is
   begin
      case Ch is
         when '#' =>
            Core_String := Buffer;
            Buffer      := E_Strings.Empty_String;
            Acceptable  := Char_Set'(End_Indicator => True,
                                     'E'           => True,
                                     others        => False);
            State       := End_Base;
         when '_' =>
            Syntax_OK := Legal_Underline (OK => Legal_Digit);
         when others =>                  --must be a legal digit
            Store (Ch => Ch);
      end case;
   end Do_Based_Part;

   -----------------------------------------------

   procedure Do_End_Base
   --# global in     Ch;
   --#        in out Acceptable;
   --#           out State;
   --# derives Acceptable from *,
   --#                         Ch &
   --#         State      from Ch;
   is
   begin
      if Ch = End_Indicator then
         State := Finished;
      else                                               -- must be 'E'
         Acceptable := Char_Set'('+' => True, '0' .. '9' => True, others => False);
         State      := Exp_Start;
      end if;
   end Do_End_Base;

   -----------------------------------------------

   procedure Do_Decimal_Start
   --# global in     Ch;
   --#        in out Buffer;
   --#        in out Places_Count;
   --#           out Acceptable;
   --#           out Decimal_Point_Found;
   --#           out State;
   --# derives Acceptable,
   --#         Decimal_Point_Found,
   --#         State               from  &
   --#         Buffer              from *,
   --#                                  Ch &
   --#         Places_Count        from *;
   is
   begin
      Decimal_Point_Found := True;
      Store (Ch => Ch);
      Places_Count := Places_Count + 1;
      Acceptable   := Char_Set'(End_Indicator => True,
                                '0' .. '9'    => True,
                                '_'           => True,
                                'E'           => True,
                                others        => False);
      State        := Decimal_Part;
   end Do_Decimal_Start;

   -----------------------------------------------

   procedure Do_Decimal_Part
   --# global in     Ch;
   --#        in     In_Ptr;
   --#        in     S;
   --#        in out Acceptable;
   --#        in out Buffer;
   --#        in out Core_String;
   --#        in out Places_Count;
   --#        in out State;
   --#        in out Syntax_OK;
   --# derives Acceptable,
   --#         Buffer,
   --#         Places_Count,
   --#         State        from *,
   --#                           Ch &
   --#         Core_String  from *,
   --#                           Buffer,
   --#                           Ch &
   --#         Syntax_OK    from *,
   --#                           Ch,
   --#                           In_Ptr,
   --#                           S;
   is
   begin
      case Ch is
         when End_Indicator =>
            Core_String := Buffer;
            State       := Finished;
         when 'E' =>
            Core_String := Buffer;
            Buffer      := E_Strings.Empty_String;
            Acceptable  := Char_Set'('+' => True, '-' => True, '0' .. '9' => True, others => False);
            State       := Exp_Start;
         when '_' =>
            Syntax_OK := Legal_Underline (OK => Char_Set'('0' .. '9' => True, others => False));
         when others =>
            Store (Ch => Ch);
            Places_Count := Places_Count + 1;
      end case;
   end Do_Decimal_Part;

   -----------------------------------------------

   procedure Do_Exp_Start
   --# global in     Ch;
   --#        in out Buffer;
   --#           out Acceptable;
   --#           out Exponent_Found;
   --#           out Exp_Sign;
   --#           out State;
   --# derives Acceptable,
   --#         Exp_Sign,
   --#         State          from Ch &
   --#         Buffer         from *,
   --#                             Ch &
   --#         Exponent_Found from ;
   is
   begin
      Exponent_Found := True;
      case Ch is
         when '-' | '+' =>
            Exp_Sign   := Ch;
            Acceptable := Char_Set'('0' .. '9' => True, others => False);
            State      := Exp_Part;
         when others =>
            Exp_Sign := '+';
            Store (Ch => Ch);
            Acceptable := Char_Set'(End_Indicator => True,
                                    '0' .. '9'    => True,
                                    '_'           => True,
                                    others        => False);
            State      := Exp_Part;
      end case;
   end Do_Exp_Start;

   -----------------------------------------------

   procedure Do_Exp_Part
   --# global in     Ch;
   --#        in     In_Ptr;
   --#        in     S;
   --#        in out Acceptable;
   --#        in out Buffer;
   --#        in out Exp_String;
   --#        in out State;
   --#        in out Syntax_OK;
   --# derives Acceptable,
   --#         Buffer,
   --#         State      from *,
   --#                         Ch &
   --#         Exp_String from *,
   --#                         Buffer,
   --#                         Ch &
   --#         Syntax_OK  from *,
   --#                         Ch,
   --#                         In_Ptr,
   --#                         S;
   is
   begin
      case Ch is
         when End_Indicator =>
            Exp_String := Buffer;
            State      := Finished;
         when '_' =>
            Syntax_OK := Legal_Underline (OK => Char_Set'('0' .. '9' => True, others => False));
         when others =>               -- '0'..'9'
            Store (Ch => Ch);
            Acceptable := Char_Set'(End_Indicator => True,
                                    '0' .. '9'    => True,
                                    '_'           => True,
                                    others        => False);
      end case;
   end Do_Exp_Part;

begin -- Parse_String

   Acceptable          := Char_Set'('0' .. '9' => True, others => False);
   State               := Initial;
   Syntax_OK           := True;
   Decimal_Point_Found := False;
   Exponent_Found      := False;
   Exp_Sign            := '+';
   Base_Found          := False;
   Digits_Read         := 0;
   Places_Count        := 0;
   Base                := 10;

   Core_String := E_Strings.Empty_String;
   Exp_String  := E_Strings.Copy_String (Str => "0");
   Buffer      := E_Strings.Empty_String;
   Legal_Digit := Char_Set'(Character => False);

   In_Ptr := 1;

   loop
      exit when not Syntax_OK;                    -- don't look beyond first error

      if In_Ptr > E_Strings.Get_Length (E_Str => S) then -- end of string
         Ch := End_Indicator;
      else
         Ch := E_Strings.Get_Element (E_Str => S,
                                      Pos   => In_Ptr);                -- get Character
         Caps (Ch => Ch);
      end if;

      -- check legality of Character against acceptable set
      if not Acceptable (Ch) then
         Syntax_OK := False;
         exit;
      end if;

      -- if we get here we have legal Character to deal with;
      case State is
         when Initial =>
            Do_Initial;
         when Leading_Zero =>
            Do_Leading_Zero;
         when Leading_Underline =>
            Do_Leading_Underline;
         when Later_Digits =>
            Do_Later_Digits;
         when Base_Start =>
            Do_Base_Start;
         when Based_Part =>
            Do_Based_Part;
         when End_Base =>
            Do_End_Base;
         when Decimal_Start =>
            Do_Decimal_Start;
         when Decimal_Part =>
            Do_Decimal_Part;
         when Exp_Start =>
            Do_Exp_Start;
         when Exp_Part =>
            Do_Exp_Part;
         when Finished =>
            null; -- can't be reached because of exit below
      end case;

      exit when State = Finished;

      In_Ptr := In_Ptr + 1;
   end loop;

   Places_After_Point := Places_Count;
   Legal_Syntax       := Syntax_OK;
end ParseString;
