----------------------------------------------------------------------
--  Dictionary.Scanner - 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   -- Standard Ada units
  Ada.Wide_Text_IO,
  Ada.Strings.Wide_Fixed;

with -- Application specific units
  Utilities;
package body Dictionary.Scanner is
   use Ada.Wide_Text_IO;

   ------------------------------------------------------------------
   -- Internal utilities                                           --
   ------------------------------------------------------------------

   -- Invariants:
   -- The_Token is the current token
   -- Cur_Char is the next character to process, undefined if
   --   At_Eol is true meaning that the current character is the
   --   end of line.

   The_Token   : Token := (Kind => EoL);

   Cur_Char    : Wide_Character;
   At_Eol      : Boolean := True;
   From_String : Boolean := False;

   Line_Number : Count := 0;

   ---------------
   -- Next_Char --
   ---------------

   --  Buffer size is arbitrary, make it big enough for (almost) all
   --  input lines to fit in. Note that the size of input lines is NOT
   --  limited by the buffer size, it is just a matter of optimization
   Buffer   : Wide_String (1..200);
   Buf_Inx  : Natural := 1;
   Buf_Last : Natural := 0;

   procedure Next_Char is
   begin
      if Buf_Inx = Buf_Last and Buf_Last = Buffer'Last and not From_String then
         -- Buffer was too short, read next part
         -- (may read an empty string, but it's OK)
         Get_Line (Buffer, Buf_Last);
         Buf_Inx := 1;

      elsif At_Eol then
         if From_String then
            if Buf_Inx /= 1 then
               -- Not the pseudo initial Eol, Simulate End Of File
               raise End_Error;
            end if;
         else
            Line_Number := Line_Number + 1;
            Get_Line (Buffer, Buf_Last);
            Buf_Inx     := 1;
         end if;

      else
         Buf_Inx := Buf_Inx + 1;
      end if;

      if Buf_Inx > Buf_Last then
         -- Includes case of empty line
         At_Eol := True;
         return;
      end if;

      At_Eol   := False;
      Cur_Char := Buffer (Buf_Inx);
   end Next_Char;


   ------------------------------------------------------------------
   -- Exported subprograms                                         --
   ------------------------------------------------------------------

   ------------------
   -- Current_Name --
   ------------------

   function Current_Name return Wide_String is
   begin
      return The_Token.Text (1 .. The_Token.Length);
   end Current_Name;

   -------------------
   -- Current_Token --
   -------------------

   function Current_Token return Token is
   begin
      return The_Token;
   end Current_Token;

   -----------
   -- Error --
   -----------

   procedure Error (Message : Wide_String) is
      use Utilities;
   begin
      User_Message (Buffer (1..Buf_Last));
      User_Message ((1..Buf_Inx-1 => ' ') & '!');
      User_Message (Count'Wide_Image (Line_Number) & ": " & Message);
      raise Syntax_Error;
   end Error;

   ----------------
   -- Next_Token --
   ----------------

   -- The following declaration ensures that we get an error if we add a Character_Token
   -- and forget to modify the following elements.
   Char_Tokens : constant Wide_String (Token_Kind'Pos (Character_Token_Kind'First) ..
                                       Token_Kind'Pos (Character_Token_Kind'Last))
     := "{};,.";
   Char_Token_Values : constant array (Char_Tokens'Range) of Token
     := ((Kind => Left_Bracket),
         (Kind => Right_Bracket),
         (Kind => Semi_Colon),
         (Kind => Comma),
         (Kind => Period));

   procedure Next_Token is
      use Ada.Strings.Wide_Fixed;
      use Utilities;

      In_Quotes : Boolean; -- True if inside "..."
   begin
      if The_Token.Kind = EoF then
         -- EoF found => stay there
         return;

      elsif The_Token.Kind = Eol then
         -- We were at EoL
         -- Skip blank lines and comment lines
         Next_Char;
         loop
            -- We do not need to check EoL here
            if At_Eol then
               -- Empty line
               null;
            elsif Cur_Char = '#' then
               while not At_Eol loop
                  Next_char;
               end loop;
            elsif Cur_Char > ' ' then
               exit;
            end if;
            Next_Char;
         end loop;

      else
         -- Skip blanks
         loop
            if At_Eol then
               The_Token := (Kind => EoL);
               return;
            end if;
            exit when Cur_Char > ' ';
            Next_Char;
         end loop;
      end if;

      -- Here we have read a non-blank character
      -- Is it something special?
      case Cur_Char is
         when '=' =>
            Next_Char;
            if At_Eol then
               Error ("Unexpected =");
            elsif Cur_Char = '>' then
               The_Token := (Kind => Arrow);
            else
               Error ("Unexpected =" & Cur_Char);
            end if;
            Next_Char;

         when '{' | '}' | ';' | ',' | '.' =>
            The_Token := Char_Token_Values (Index (Char_Tokens, Cur_Char & ""));
            Next_Char;

         when others =>
            The_Token := (Kind => Name, Length => 1, Text => (1 => Cur_Char, Others => ' '));
            In_Quotes := Cur_Char = '"';
            begin
               Next_Char;
               loop
                  exit when At_Eol;

                  if Cur_Char = '"' then
                     In_Quotes := not In_Quotes;

                  elsif not In_Quotes then
                     exit when Cur_Char <= ' ' or Index (Char_Tokens, Cur_Char & "") /= 0;
                  end if;

                  if The_Token.Length = The_Token.Text'Last then
                     Error ("Identifier too long");
                     return;
                  end if;
                  The_Token.Length := The_Token.Length + 1;
                  The_Token.Text (The_Token.Length) := Cur_Char;
                  Next_Char;
               end loop;

               -- Check for keywords
               if To_Upper (The_Token.Text (1..The_Token.Length)) = "ABS" then
                  The_Token := (Kind => Keyword, Key => Key_Abs);
               elsif To_Upper (The_Token.Text (1..The_Token.Length)) = "ACCESS" then
                  The_Token := (Kind => Keyword, Key => Key_Access);
               elsif To_Upper (The_Token.Text (1..The_Token.Length)) = "ALL" then
                  The_Token := (Kind => Keyword, Key => Key_All);
               elsif To_Upper (The_Token.Text (1..The_Token.Length)) = "IN" then
                  The_Token := (Kind => Keyword, Key => Key_In);
               elsif To_Upper (The_Token.Text (1..The_Token.Length)) = "NOT" then
                  The_Token := (Kind => Keyword, Key => Key_Not);
               elsif To_Upper (The_Token.Text (1..The_Token.Length)) = "RETURN" then
                  The_Token := (Kind => Keyword, Key => Key_Return);
               end if;

            exception
               when End_Error =>
                  -- Malformed file
                  null; -- same as EoL
            end;
      end case;

   exception
      when End_Error =>
         The_Token := (Kind => EoF);
   end Next_Token;

   ----------------
   -- Start_Scan --
   ----------------

   procedure Start_Scan (Substitution : Wide_String := "") is
   begin
      if Substitution /= "" then
         Buffer (1..Substitution'Length) := Substitution;
         Buf_Last := Substitution'Length;
         From_String := True;
      end if;
      Next_Token;
   end Start_Scan;

end Dictionary.Scanner;

