--  file: scanner2.adb
--  ($Id$)

with Ada.Text_IO; use Ada.Text_IO;
package body Scanner2 is

   Current_Id : Token_Id := Start_Token;
   Current_Integer : Integer := 0;

   C : Character := ' ';

   Is_Whitespace : constant array (Character) of Boolean :=
     (' ' | ASCII.Nul | ASCII.HT => True, others => False);
   Is_Operator : constant array (Character) of Boolean :=
     ('+' | '-' | '*' | '/' | ')' | '(' => True, others => False);
   Is_Letter : constant array (Character) of Boolean :=
     ('a' .. 'z' | 'A' .. 'Z' => True, others => False);
   Is_Digit : constant array (Character) of Boolean :=
     ('0' .. '9' => True, others => False);

   --  Note that Ada's standard text input package is based on that of Pascal,
   --  which goes to a lot of trouble to not treat ends of lines as characters.
   --  That traces back to the original Pascal implementation, which was on an
   --  architecture that had 6-bit characters and where the encoding of line-ends
   --  was context-sensitive, depending on where in a 60-bit word the line end came.
   --  That is, in CDC "display code" the zero-byte (6-bits of zero)
   --  was used for the character ":", and there is no end-of-line character.
   --  An end of line was normally indicated by two bytes of zero in the
   --  9th and 10th positions of a word, in which case all immediately
   --  preceding zero bytes were also included in the end-of-line mark.
   --  This had the side-effect that if one printed "12345678::"
   --  it would be read back as "12345678", and "123:::::::" would be
   --  read back as "123".
   --  However, in this case we are trying to limit input to one line at a time, so
   --  we add the routine Next_C to make the end of line visible as a token.

   At_End : Boolean := False;

   function Get_ID return Token_ID is
   begin
      return Current_Id;
   end Get_ID;

   function Get_Integer return Integer is
   begin
      return Current_Integer;
   end Get_Integer;

   function Get_String return String is
   begin
      --  needs a real implementation
      return "stub";
   end Get_String;

   function Get_Line return Integer is
   begin
      --  needs a real implementation
      return 0;
   end Get_Line;

   function Get_Column return Integer is
   begin
      --  needs a real implementation
      return 0;
   end Get_Column;

   procedure Next_C is
      pragma Inline (Next_C);
   begin
      if At_End then
         Skip_Line;
         At_End := False;
      end if;
      if not End_Of_Line then Get (C);
      else
         C := ASCII.LF;
         At_End := True;
      end if;
   end Next_C;

   procedure Get_Next_Token is
      ID : Token_Id renames Current_Id;
   begin
      while Is_Whitespace (C) loop
         Next_C;
      end loop;
      if Is_Operator (C) then
         ID := Token_Id (C);
         Next_C;
      elsif Is_Digit (C) then
         ID := 'N';
         Current_Integer := 0;
         loop
            Current_Integer := Current_Integer * 10
              + (Character'Pos (C) - Character'Pos ('0'));
            Next_C;
            exit when not Is_Digit (C);
         end loop;
      elsif At_End then
         ID := Eol_Token;
         C := ' ';
      else
         ID := Err_Token;
         Next_C;
      end if;
   exception
      when Constraint_Error =>
         ID := Err_Token;
         Next_C;
   end Get_Next_Token;

   function Image return String is
   begin
      if Current_ID = 'N' then return Integer'Image (Current_Integer);
      end if;
      if Current_ID = Start_Token then return "*START*";
      end if;
      if Current_ID = Err_Token then return "*ERROR*";
      end if;
      if Current_ID = Eol_Token then return "*EOL*";
      end if;
      return (1 => Character (Current_ID));
   end Image;

end Scanner2;