-- $Date: 2003/12/28 05:54:57 $
-- $Revision: 1.10 $
-- $Author: jcrocholl $

with Ada.Text_IO;
with Ada.Unchecked_Deallocation;
use Ada;

with Integer_Strings;
use Integer_Strings;

with Gnat.IO_Aux;
use Gnat;

package body Parsers is

   function "-"
     (A : in String)
     return Unbounded_String
     renames To_Unbounded_String;

   function "-"
     (A : in Unbounded_String)
     return String
     renames To_String;

   -- Constructor for a parser on STDIN.
   function Current_Input
     return Parser is
   begin
      return new Parser_Record;
   end Current_Input;

   -- Constructor for a parser on a file.
   function Open
     (File_Name : in String)
     return Parser
   is
      Result : Parser := new Parser_Record;
   begin
      Result.File_Name := -File_Name;
      Text_IO.Open(Result.File, Text_IO.In_File, File_Name);
      return Result;
   end Open;

   procedure Free is new Unchecked_Deallocation(Parser_Record, Parsers.Parser);

   -- Destructor: free memory and set instance to null.
   procedure Close
     (Parser : in out Parsers.Parser) is
   begin
      if Length(Parser.File_Name) /= 0 then
         -- don't close if it's standard input
         Text_IO.Close(Parser.File);
      end if;
      Free(Parser);
      Parser := null;
   end Close;

   -- Enable / disable the automatic read feature. The default is
   -- False.
   --
   -- If Auto_Read is set to True, the application doesn't need to
   -- call Next_Line because it's done automatically and
   -- transparently.
   procedure Set_Auto_Read
     (Parser    : in Parsers.Parser-- Modify this parser.
      Auto_Read : in Boolean) is     -- New value for auto read.
   begin
      Parser.Auto_Read := Auto_Read;
   end Set_Auto_Read;

   -- Read next line of input.
   function Next_Line
     (Parser : in Parsers.Parser)
     return Boolean is
   begin
      if Length(Parser.File_Name) = 0 then
         Parser.Line := -IO_Aux.Get_Line;
      else
         if Text_IO.End_Of_File(Parser.File) then
            return False;
         end if;
         Parser.Line := -IO_Aux.Get_Line(Parser.File);
      end if;
      Parser.Cursor := 1;
      Parser.Line_Number := Parser.Line_Number + 1;
      return True;
   end Next_Line;

   -- Check cursor position. Returns true if and only if the cursor is
   -- at the end of the current line.
   function End_Of_Line
     (Parser : in Parsers.Parser)
     return Boolean is
   begin
      return Parser.Cursor > Length(Parser.Line);
   end End_Of_Line;
   pragma Inline(End_Of_Line);

   -- Check cursor position. Returns true if and only if the end of
   -- input has been reached.
   function End_Of_File
     (Parser : in Parsers.Parser)
     return Boolean is
   begin
      return Text_IO.End_Of_File(Parser.File);
   end End_Of_File;
   pragma Inline(End_Of_File);

   -- Advance cursor position.
   procedure Skip
     (Parser : in Parsers.Parser;
      Count  : in Positive := 1)
   is
   begin
      Parser.Cursor := Parser.Cursor + Count;
   end Skip;

   -- Read a character and advance cursor.
   function Skip
     (Parser : in Parsers.Parser)
     return Character
   is
      Result : Character := Element(Parser.Line, Parser.Cursor);
   begin
      Parser.Cursor := Parser.Cursor + 1;
      return Result;
   end Skip;

   -- Read a number of characters.
   function Skip
     (Parser : in Parsers.Parser;
      Count  : in Positive)
     return String
   is
      Result : String := Slice(Parser.Line,
        Parser.Cursor , Parser.Cursor + Count - 1);
   begin
      Parser.Cursor := Parser.Cursor + Count;
      return Result;
   end Skip;

   -- Read a character, don't move cursor.
   function Char
     (Parser : in Parsers.Parser)
     return Character is
   begin
      return Element(Parser.Line, Parser.Cursor);
   end Char;
   pragma Inline(Char);

   -- Check for a character.
   function Found
     (Parser : in Parsers.Parser;
      Char   : in Character)
     return Boolean is
   begin
      if End_Of_Line(Parser) then return False; end if;
      return Parsers.Char(Parser) = Char;
   end Found;
   pragma Inline(Found);

   -- Check for a string.
   function Found
     (Parser : in Parsers.Parser;
      Text   : in String)
     return Boolean
   is
      First : Positive := Parser.Cursor;
      Last  : Positive := Parser.Cursor + Text'Length - 1;
   begin
      return Length(Parser.Line) >= Last and then
        Slice(Parser.Line, First, Last) = Text;
   end Found;

   -- Check for any one out of a number of characters.
   function Found_Any
     (Parser : in Parsers.Parser;
      Chars  : in String)
     return Boolean
   is
      Found : Boolean := False;
   begin
      if End_Of_Line(Parser) then return False; end if;
      for Index in Chars'Range loop
         if Parsers.Found(Parser, Chars(Index)) then
            Found := True;
         end if;
         exit when Found;
      end loop;
      return Found;
   end Found_Any;

   -- Skip one character if found.
   function Skip
     (Parser : in Parsers.Parser;
      Char   : in Character)
     return Boolean
   is
      Result : Boolean := Found(Parser, Char);
   begin
      if Result then Skip(Parser); end if;
      return Result;
   end Skip;

   -- Skip a string if found.
   function Skip
     (Parser : in Parsers.Parser;
      Text   : in String)
     return Boolean
   is
      Result : Boolean := Found(Parser, Text);
   begin
      if Result then Skip(Parser, Text'Length); end if;
      return Result;
   end Skip;

   -- Skip one character if found.
   procedure Skip
     (Parser : in Parsers.Parser;
      Char   : in Character)
   is
      Dummy : Boolean;
   begin
      Dummy := Skip(Parser, Char);
   end Skip;

   -- Skip any out of a number of characters as long as found.
   function Skip_Any
     (Parser : in Parsers.Parser;
      Chars  : in String)
     return Boolean
   is
      Result : Boolean := False;
   begin
      loop
         if End_Of_Line(Parser) or else
           not Found_Any(Parser, Chars)
         then return Result;
         end if;
         Skip(Parser);
         Result := True;
      end loop;
   end Skip_Any;

   -- Skip any out of a number of characters as long as found.
   procedure Skip_Any
     (Parser : in Parsers.Parser;
      Chars  : in String)
   is
      Result : Boolean;
   begin
      Result := Skip_Any(Parser, Chars);
   end Skip_Any;

   function Scan_Any
     (Parser : in Parsers.Parser;
      Chars  : in String)
     return Boolean
   is
      Result : Boolean := False;
   begin
      loop
         if End_Of_Line(Parser) or else
           Found_Any(Parser, Chars)
         then return Result;
         end if;
         Result := True;
         Skip(Parser);
      end loop;
   end Scan_Any;

   procedure Scan_Any
     (Parser : in Parsers.Parser;
      Chars  : in String)
   is
      Result : Boolean;
   begin
      Result := Scan_Any(Parser, Chars);
   end Scan_Any;

   -- Skip a string if found.
   procedure Skip
     (Parser : in Parsers.Parser;
      Text   : in String)
   is
      Dummy : Boolean;
   begin
      Dummy := Skip(Parser, Text);
   end Skip;

   function Scan
     (Parser : in Parsers.Parser;
      Char   : in Character)
     return Boolean
   is
      Cursor : Positive := Parser.Cursor;
   begin
      loop
         if Cursor > Length(Parser.Line) then
            return False;
         elsif Element(Parser.Line, Parser.Cursor) = Char then
            Parser.Cursor := Cursor;
            return True;
         end if;
         Cursor := Cursor + 1;
      end loop;
   end Scan;

   procedure Scan
     (Parser : in Parsers.Parser;
      Char   : in Character)
   is
      Result : Boolean := Scan(Parser, Char);
   begin
      null;
   end Scan;

   function Scan
     (Parser : in Parsers.Parser;
      Text   : in String)
     return Boolean
   is
      Old_Cursor       : Positive := Parser.Cursor;
      First_Char       : Character := Text(Text'First);
      Last_Char_Offset : Natural := Text'Length - 1;
   begin
      loop
         if not Scan(Parser, First_Char) then
            Parser.Cursor := Old_Cursor;
            return False;
         else
            if Parsers.Found(Parser, Text) then
               return True;
            else
               Skip(Parser);
            end if;
         end if;
      end loop;
   end Scan;

   procedure Scan
     (Parser : in Parsers.Parser;
      Text   : in String)
   is
      Result : Boolean := Scan(Parser, Text);
   begin
      null;
   end Scan;

   -- special reading functions
   function Read_Natural
     (Parser : in Parsers.Parser)
     return Natural
   is
      C      : Character;
      Result : Natural := 0;
   begin
      loop
         exit when End_Of_Line(Parser);
         C := Char(Parser);
         exit when not (C in '0' .. '9');
         Result := Result * 10 +
           Character'Pos(C) - Character'Pos('0');
         Skip(Parser);
      end loop;
      return Result;
   end Read_Natural;

   function Read_Positive
     (Parser : in Parsers.Parser)
     return Positive
   is
      Expected_Positive : exception;
      Result : Natural := Read_Natural(Parser);
   begin
      if Result = 0 then
         Error(Parser, "expected positive number");
      end if;
      return Result;
   end Read_Positive;

   function Read_Integer
     (Parser : in Parsers.Parser)
     return Integer
   is
   begin
      if Skip(Parser, '-') then
         return -Read_Natural(Parser);
      else
         return Read_Natural(Parser);
      end if;
   end Read_Integer;

   function Read_Float
     (Parser : in Parsers.Parser)
     return Float
   is
      C           : Character;
      Result      : Float := 0.0;
      Digit_Value : Float := 1.0;
   begin
      loop
         C := Char(Parser);
         exit when not (C in '0' .. '9');
         Result := Result * 10.0 +
           Float(Character'Pos(C) - Character'Pos('0'));
         Skip(Parser);
      end loop;
      if not Skip(Parser, '.') then
         return Result;
      end if;
      loop
         C := Char(Parser);
         exit when not (C in '0' .. '9');
         Digit_Value := Digit_Value / 10.0;
         Result := Result + Digit_Value *
           Float(Character'Pos(C) - Character'Pos('0'));
         Skip(Parser);
      end loop;
      return Result;
   end Read_Float;

   function Read_Word
     (Parser          : in Parsers.Parser;
      Delimiter_Chars : in String := Whitespace)
     return String
   is
      Start : Positive := Parser.Cursor;
   begin
      Scan_Any(Parser, Delimiter_Chars);
      return Slice(Parser.Line, Start, Parser.Cursor - 1);
   end Read_Word;

   -- Read the rest of the line, don't move cursor.
   function Rest_Of_Line
     (Parser : in Parsers.Parser)
     return String
   is
   begin
      -- if Parser.Cursor > Length(Parser.Line) then
      -- return "";
      -- else
      return Slice(Parser.Line, Parser.Cursor, Length(Parser.Line));
      --end if;
   end Rest_Of_Line;

   -- return file name, line and column number for error messages
   function Position
     (Parser : in Parsers.Parser)
     return String
   is
   begin
      if Parser.File_Name = "" then
         return "Current_Input:" &
           To_String(Parser.Line_Number) & ":" &
           To_String(Parser.Cursor) & ": ";
      else
         return -Parser.File_Name & ":" &
           To_String(Parser.Line_Number) & ":" &
           To_String(Parser.Cursor) & ": ";
      end if;
   end Position;

   -- print an error message to current error
   procedure Warning
     (Parser  : in Parsers.Parser;
      Message : in String) is
   begin
      Text_IO.Put_Line(Text_IO.Current_Error, Position(Parser) & Message);
   end Warning;

   -- same as warn plus raise Parse_Error
   procedure Error
     (Parser  : in Parsers.Parser;
      Message : in String) is
   begin
      Warning(Parser, Message);
      raise Parse_Error;
   end Error;

end Parsers;