-------------------------------------------------
--                                             --
--       Scanner generated by Coco/R           --
--                                             --
-- (assuming FileIO library will be available) --
-------------------------------------------------

with FileIO;

package body CRS is


   noSYMB  : constant := 41;  -- error token code
   -- not only for errors but also for not finished states of scanner analysis
   EOF     : constant Character := FileIO.EOF;
   EOL     : constant Character := FileIO.CR;
   CR      : constant Character := FileIO.CR;
   LF      : constant Character := FileIO.LF;
   BlkSize : constant := 16384;



   subtype  BufBlock       is String (1 .. (BlkSize));
   type     BufBlock_Ptr   is access BufBlock;

   type     Buffer         is array (Integer range 0 .. 31) of BufBlock_Ptr;
   type     StartTable     is array (Integer range 0 .. 255) of Integer;

   type     GetCH          is access function (pos: in     INT32) return Character;



   lastCh      : Character;
   ch          : Character;   -- current input character
   curLine     : Integer;     -- current input line (may be higher than line)
   lineStart   : INT32;       -- start position of current line
--    apx         : INT32;       -- length of appendix (CONTEXT phrase)
   oldEols     : Integer;     -- number of EOLs in a comment

   bp          : INT32;       -- current position in buf
   bp0         : INT32;       -- position of current token

   LBlkSize    : INT32;       -- BlkSize
   inputLen    : INT32;       -- source file size

   buf         : Buffer;      -- source buffer for low-level access
   start       : StartTable;  -- start state for every character
   Current_Ch  : GetCH;



   function ORDL (n: in     INT32) return CARDINAL renames FileIO.ORDL;


   procedure Err
     (nr    : in     Integer;
      line  : in     Integer;
      col   : in     Integer;
      pos   : in     INT32)
   is
   begin
      errors := errors + 1;
   end Err;


   --
   -- Return global variable ch
   --
   procedure Next_Ch
   is
   begin
      lastCh := ch;
      bp := bp + 1;
      ch := Current_Ch (bp);
      if  (ch = EOL) or else ((ch = FileIO.LF) and then (lastCh /= EOL))  then
         curLine := curLine + 1;
         lineStart := bp;
      end if;
   end Next_Ch;


   function Comment return Boolean
   is
      level       : Integer;
      startLine   : Integer;
      oldLineStart: INT32;
   begin
      level        := 1;
      startLine    := curLine;
      oldLineStart := lineStart;
      if  (ch = '-')  then
         Next_Ch;
         if  (ch = '-')  then
            Next_Ch;
            loop
               if  (ch = Character'Val (10))  then
                  level   := level - 1;
                  oldEols := curLine - startLine;
                  Next_Ch;
                  if  level = 0  then
                     return TRUE;
                  end if;
               elsif  ch = EOF  then
                  return FALSE;
               else
                  Next_Ch;
               end if;
            end loop;
         else
            if  (ch = CR) or else (ch = LF)  then
               curLine   := curLine - 1;
               lineStart := oldLineStart;
            end if;
            bp := bp - 1;
            ch := lastCh;
            return FALSE;
         end if;
      end if;
      if  (ch = '(')  then
         Next_Ch;
         if  (ch = '*')  then
            Next_Ch;
            loop
               if  (ch = '*')  then
                  Next_Ch;
                  if (ch = ')')  then
                     level := level - 1;
                     Next_Ch;
                     if  level = 0  then
                        return TRUE;
                     end if;
                  end if;
               elsif  (ch = '(')  then
                  Next_Ch;
                  if  (ch = '*') then
                     level := level + 1;
                     Next_Ch;
                  end if;
               elsif  ch = EOF  then
                  return FALSE;
               else
                  Next_Ch;
               end if;
            end loop;
         else
            if  (ch = CR) or else (ch = LF)  then
               curLine   := curLine - 1;
               lineStart := oldLineStart;
            end if;
            bp := bp - 1;
            ch := lastCh;
            return FALSE;
         end if;
      end if;
      
      return FALSE;
   end Comment;


   --
   -- Gets next symbol from source file
   --
   procedure Get (sym:    out CARDINAL)
   is

      state: CARDINAL;

      function Equal (S: in     String) return Boolean
      is
         I: CARDINAL;
         q: INT32;
      begin
         if  nextLen /= FileIO.SLENGTH (S)  then
            return FALSE;
         end if;

         I := S'First + 1;
         q := bp0 + 1;

         while  I <= nextLen  loop
            if  Current_Ch (q) /= S (I)  then
               return FALSE;
            end if;
            I := I + 1;
            q := q + 1;
         end loop;

         return TRUE;
      end Equal;

      procedure Check_Literal
      is
      begin
         case  Current_Ch (bp0)  is
         when 'A' =>
               if Equal ("ANY") then
                  sym := 23; 
               end if;
            when 'C' =>
               if Equal ("CASE") then
                  sym := 19; 
               elsif Equal ("CHARACTERS") then
                  sym := 10; 
               elsif Equal ("CHR") then
                  sym := 24; 
               elsif Equal ("COMMENTS") then
                  sym := 14; 
               elsif Equal ("COMPILER") then
                  sym := 5; 
               elsif Equal ("CONTEXT") then
                  sym := 34; 
               end if;
            when 'E' =>
               if Equal ("END") then
                  sym := 9; 
               end if;
            when 'F' =>
               if Equal ("FROM") then
                  sym := 15; 
               end if;
            when 'I' =>
               if Equal ("IGNORE") then
                  sym := 18; 
               end if;
            when 'N' =>
               if Equal ("NAMES") then
                  sym := 12; 
               elsif Equal ("NESTED") then
                  sym := 17; 
               end if;
            when 'P' =>
               if Equal ("PRAGMAS") then
                  sym := 13; 
               elsif Equal ("PRODUCTIONS") then
                  sym := 6; 
               end if;
            when 'S' =>
               if Equal ("SYNC") then
                  sym := 33; 
               end if;
            when 'T' =>
               if Equal ("TO") then
                  sym := 16; 
               elsif Equal ("TOKENS") then
                  sym := 11; 
               end if;
            when 'W' =>
               if Equal ("WEAK") then
                  sym := 28; 
               end if;
            when others =>
               null;
         end case;
      end Check_Literal;

   begin -- Get
      while  (ch = ' ') or else
            (((ch >= Character'Val (9)) and then (ch <= Character'Val (10))) or else
            (ch = Character'Val (13))) loop  Next_Ch;  end loop;
      if  ((ch = '-') or else (ch = '(')) and then Comment  then
         Get (sym);
         return;
      end if;

      pos      := nextPos;   
      nextPos  := bp;
      col      := nextCol;   
      nextCol  := FileIO.INTL (bp - lineStart);
      line     := nextLine; 
      nextLine := curLine;
      len      := nextLen;   
      nextLen  := 0;
--       apx      := 0; 
      state    := start (Character'Pos (ch)); 
      bp0      := bp;

      loop
         Next_Ch; 
         nextLen := nextLen + 1;
         case  state  is
               when  1 =>
                  if  (((ch >= '0') and then (ch <= '9')) or else
                           ((ch >= 'A') and then (ch <= 'Z')) or else
                           (ch = '_') or else
                           ((ch >= 'a') and then (ch <= 'z')))  then
                     null; 
                  else
                     sym := 1; 
                     Check_Literal;
                     return;
                  end if;
               when  2 =>
                     sym := 2; 
                     return;
               when  3 =>
                     sym := 3; 
                     return;
               when  4 =>
                  if  (((ch >= '0') and then (ch <= '9')))  then
                     null; 
                  else
                     sym := 4; 
                     return;
                  end if;
               when  5 =>
                  if  (((ch >= '0') and then (ch <= '9')) or else
                           ((ch >= 'A') and then (ch <= 'Z')) or else
                           (ch = '_') or else
                           ((ch >= 'a') and then (ch <= 'z')))  then
                     null; 
                  else
                     sym := 42; 
                     return;
                  end if;
               when  6 =>
                  if  ((ch = Character'Val (0)) or else
                           ((ch >= ' ') and then (ch <= '!')) or else
                           (ch >= '#'))  then
                     null; 
                  elsif  ((ch = Character'Val (10)) or else
                              (ch = Character'Val (13)))  then
                     State := 3; 
                  elsif  (ch = '"')  then
                     State := 2; 
                  else
                     sym := noSYMB;
                     return;
                  end if;
               when  7 =>
                  if  ((ch = Character'Val (0)) or else
                           ((ch >= ' ') and then (ch <= '&')) or else
                           (ch >= '('))  then
                     null; 
                  elsif  ((ch = Character'Val (10)) or else
                              (ch = Character'Val (13)))  then
                     State := 3; 
                  elsif  (ch = ''')  then
                     State := 2; 
                  else
                     sym := noSYMB;
                     return;
                  end if;
               when  8 =>
                     sym := 7; 
                     return;
               when  9 =>
                  if  (ch = '.')  then
                     State := 12; 
                  elsif  (ch = '>')  then
                     State := 23; 
                  elsif  (ch = ')')  then
                     State := 25; 
                  else
                     sym := 8; 
                     return;
                  end if;
               when 10 =>
                     sym := 20; 
                     return;
               when 11 =>
                     sym := 21; 
                     return;
               when 12 =>
                     sym := 22; 
                     return;
               when 13 =>
                  if  (ch = '.')  then
                     State := 24; 
                  else
                     sym := 25; 
                     return;
                  end if;
               when 14 =>
                     sym := 26; 
                     return;
               when 15 =>
                     sym := 27; 
                     return;
               when 16 =>
                     sym := 29; 
                     return;
               when 17 =>
                     sym := 30; 
                     return;
               when 18 =>
                     sym := 31; 
                     return;
               when 19 =>
                     sym := 32; 
                     return;
               when 20 =>
                  if  (ch = '.')  then
                     State := 22; 
                  else
                     sym := 35; 
                     return;
                  end if;
               when 21 =>
                     sym := 36; 
                     return;
               when 22 =>
                     sym := 37; 
                     return;
               when 23 =>
                     sym := 38; 
                     return;
               when 24 =>
                     sym := 39; 
                     return;
               when 25 =>
                     sym := 40; 
                     return;
               when 26 =>
                  sym := 0; 
                  ch := Character'Val (0);
                  bp := bp - 1;
                  return;
            when others =>    -- Next_Ch already done
               sym := noSYMB;
               return;
         end case;
      end loop;
   end Get;


   --
   -- Retrieves exact The_String of max The_Length from The_Position in source file
   --
   procedure Get_String
     (The_Position   : in     INT32;
      The_Length     : in     CARDINAL;
      The_String     :    out FileIO.String_Ptr)
   is
   begin
      if  The_Length <= 0  then 
         The_String := null;
      else
         declare
            S : String (1..The_Length);
            P : INT32;         
         begin
            P := The_Position;
            for  I in S'Range  loop
               S (I) := Char_At (P); 
               P     := P + 1;
            end loop;
            The_String := new String'(S);
         end;
      end if;
   end Get_String;

   --
   -- Retrieves The_Name of symbol of The_Length at The_Position in source file
   --
   procedure Get_Name
     (The_Position   : in     INT32;
      The_Length     : in     CARDINAL;
      The_Name       :    out FileIO.String_Ptr)
   is
   begin
      if  The_Length <= 0  then 
         The_Name := null;
      else
         declare
            S : String (1..The_Length);         
            P : INT32;         
         begin
            P := The_Position;
            for  I in S'Range  loop
               S (I) := Current_Ch (P); 
               P     := P + 1;
            end loop;
            The_Name := new String'(S);
         end;
      end if;
   end Get_Name;


   --
   -- Returns exact character at position pos in source file
   --
   function Char_At (The_Position: in     INT32) return Character
   is
      C : Character;
   begin
      if  The_Position >= inputLen  then 
         return FileIO.EOF;
      end if;

      C := buf (ORDL (The_Position / LBlkSize))
               (ORDL ((The_Position mod LBlkSize)) + 1);

      if  C /= eof  then 
         return C;
      else 
         return FileIO.EOF;
      end if;
   end Char_At;


   function Up_Char_At (The_Position: in     INT32) return Character
   is
      C : Character;
   begin
      if  The_Position >= inputLen  then 
         return FileIO.EOF;
      end if;

      C := FileIO.Up_Case
            (buf (ORDL (The_Position / LBlkSize))
                 (ORDL (The_Position mod LBlkSize) + 1));

      if  C /= eof  then 
         return C ;
      else 
         return FileIO.EOF;
      end if;
   end Up_Char_At;


   --
   -- Reads and stores source file internally
   --
   procedure Reset
   is
      len   : INT32;
      I     : CARDINAL;
      read  : CARDINAL;
   begin -- assert: Source has been opened
      inputLen := FileIO.Length (Source); -- save Length of source

      I        := 0; 
      len      := inputLen;
      while  len > LBlkSize  loop
         buf (I) := new BufBlock;
         read    := BlkSize;
         FileIO.Read_Bytes (Source, buf (I).all, read);
         len := len - FileIO.INT (read); 
         I := I + 1;
      end loop;

      buf (I) := new BufBlock;
      read := ORDL (len); 
      FileIO.Read_Bytes (Source, buf (I).all, read);
      buf (I) (read) := EOF;

      curLine   := 1; 
      lineStart := -2;
      bp        := -1;
      oldEols   := 0; 
--       apx       := 0;
      errors    := 0;

      Next_Ch;
   end Reset;


begin
   Current_Ch := Char_At'Access;
   Start (  0) := 26; Start (  1) := 27; Start (  2) := 27; Start (  3) := 27; 
   Start (  4) := 27; Start (  5) := 27; Start (  6) := 27; Start (  7) := 27; 
   Start (  8) := 27; Start (  9) := 27; Start ( 10) := 27; Start ( 11) := 27; 
   Start ( 12) := 27; Start ( 13) := 27; Start ( 14) := 27; Start ( 15) := 27; 
   Start ( 16) := 27; Start ( 17) := 27; Start ( 18) := 27; Start ( 19) := 27; 
   Start ( 20) := 27; Start ( 21) := 27; Start ( 22) := 27; Start ( 23) := 27; 
   Start ( 24) := 27; Start ( 25) := 27; Start ( 26) := 27; Start ( 27) := 27; 
   Start ( 28) := 27; Start ( 29) := 27; Start ( 30) := 27; Start ( 31) := 27; 
   Start ( 32) := 27; Start ( 33) := 27; Start ( 34) :=  6; Start ( 35) := 27; 
   Start ( 36) :=  5; Start ( 37) := 27; Start ( 38) := 27; Start ( 39) :=  7; 
   Start ( 40) := 13; Start ( 41) := 14; Start ( 42) := 27; Start ( 43) := 10; 
   Start ( 44) := 27; Start ( 45) := 11; Start ( 46) :=  9; Start ( 47) := 27; 
   Start ( 48) :=  4; Start ( 49) :=  4; Start ( 50) :=  4; Start ( 51) :=  4; 
   Start ( 52) :=  4; Start ( 53) :=  4; Start ( 54) :=  4; Start ( 55) :=  4; 
   Start ( 56) :=  4; Start ( 57) :=  4; Start ( 58) := 27; Start ( 59) := 27; 
   Start ( 60) := 20; Start ( 61) :=  8; Start ( 62) := 21; Start ( 63) := 27; 
   Start ( 64) := 27; Start ( 65) :=  1; Start ( 66) :=  1; Start ( 67) :=  1; 
   Start ( 68) :=  1; Start ( 69) :=  1; Start ( 70) :=  1; Start ( 71) :=  1; 
   Start ( 72) :=  1; Start ( 73) :=  1; Start ( 74) :=  1; Start ( 75) :=  1; 
   Start ( 76) :=  1; Start ( 77) :=  1; Start ( 78) :=  1; Start ( 79) :=  1; 
   Start ( 80) :=  1; Start ( 81) :=  1; Start ( 82) :=  1; Start ( 83) :=  1; 
   Start ( 84) :=  1; Start ( 85) :=  1; Start ( 86) :=  1; Start ( 87) :=  1; 
   Start ( 88) :=  1; Start ( 89) :=  1; Start ( 90) :=  1; Start ( 91) := 16; 
   Start ( 92) := 27; Start ( 93) := 17; Start ( 94) := 27; Start ( 95) :=  1; 
   Start ( 96) := 27; Start ( 97) :=  1; Start ( 98) :=  1; Start ( 99) :=  1; 
   Start (100) :=  1; Start (101) :=  1; Start (102) :=  1; Start (103) :=  1; 
   Start (104) :=  1; Start (105) :=  1; Start (106) :=  1; Start (107) :=  1; 
   Start (108) :=  1; Start (109) :=  1; Start (110) :=  1; Start (111) :=  1; 
   Start (112) :=  1; Start (113) :=  1; Start (114) :=  1; Start (115) :=  1; 
   Start (116) :=  1; Start (117) :=  1; Start (118) :=  1; Start (119) :=  1; 
   Start (120) :=  1; Start (121) :=  1; Start (122) :=  1; Start (123) := 18; 
   Start (124) := 15; Start (125) := 19; Start (126) := 27; Start (127) := 27; 
   Start (128) := 27; Start (129) := 27; Start (130) := 27; Start (131) := 27; 
   Start (132) := 27; Start (133) := 27; Start (134) := 27; Start (135) := 27; 
   Start (136) := 27; Start (137) := 27; Start (138) := 27; Start (139) := 27; 
   Start (140) := 27; Start (141) := 27; Start (142) := 27; Start (143) := 27; 
   Start (144) := 27; Start (145) := 27; Start (146) := 27; Start (147) := 27; 
   Start (148) := 27; Start (149) := 27; Start (150) := 27; Start (151) := 27; 
   Start (152) := 27; Start (153) := 27; Start (154) := 27; Start (155) := 27; 
   Start (156) := 27; Start (157) := 27; Start (158) := 27; Start (159) := 27; 
   Start (160) := 27; Start (161) := 27; Start (162) := 27; Start (163) := 27; 
   Start (164) := 27; Start (165) := 27; Start (166) := 27; Start (167) := 27; 
   Start (168) := 27; Start (169) := 27; Start (170) := 27; Start (171) := 27; 
   Start (172) := 27; Start (173) := 27; Start (174) := 27; Start (175) := 27; 
   Start (176) := 27; Start (177) := 27; Start (178) := 27; Start (179) := 27; 
   Start (180) := 27; Start (181) := 27; Start (182) := 27; Start (183) := 27; 
   Start (184) := 27; Start (185) := 27; Start (186) := 27; Start (187) := 27; 
   Start (188) := 27; Start (189) := 27; Start (190) := 27; Start (191) := 27; 
   Start (192) := 27; Start (193) := 27; Start (194) := 27; Start (195) := 27; 
   Start (196) := 27; Start (197) := 27; Start (198) := 27; Start (199) := 27; 
   Start (200) := 27; Start (201) := 27; Start (202) := 27; Start (203) := 27; 
   Start (204) := 27; Start (205) := 27; Start (206) := 27; Start (207) := 27; 
   Start (208) := 27; Start (209) := 27; Start (210) := 27; Start (211) := 27; 
   Start (212) := 27; Start (213) := 27; Start (214) := 27; Start (215) := 27; 
   Start (216) := 27; Start (217) := 27; Start (218) := 27; Start (219) := 27; 
   Start (220) := 27; Start (221) := 27; Start (222) := 27; Start (223) := 27; 
   Start (224) := 27; Start (225) := 27; Start (226) := 27; Start (227) := 27; 
   Start (228) := 27; Start (229) := 27; Start (230) := 27; Start (231) := 27; 
   Start (232) := 27; Start (233) := 27; Start (234) := 27; Start (235) := 27; 
   Start (236) := 27; Start (237) := 27; Start (238) := 27; Start (239) := 27; 
   Start (240) := 27; Start (241) := 27; Start (242) := 27; Start (243) := 27; 
   Start (244) := 27; Start (245) := 27; Start (246) := 27; Start (247) := 27; 
   Start (248) := 27; Start (249) := 27; Start (250) := 27; Start (251) := 27; 
   Start (252) := 27; Start (253) := 27; Start (254) := 27; Start (255) := 27; 

   Error    := Err'Access; 
   LBlkSize := FileIO.INT (BlkSize);
   lastCh   := EOF;
end CRS;





