<commit_before>with Ada.IO_Exceptions;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Smart_Pointers;
with Types.Vector;
with Types.Hash_Map;

package body Reader is

   use Types;

   package ACL renames Ada.Characters.Latin_1;

   type Lexemes is (Ignored_Tok,
                    Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok,
                    Meta_Tok, Deref_Tok,
                    Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok,
                    Int_Tok, Float_Tok,
                    Str_Tok, Sym_Tok);

   type Token (ID : Lexemes := Ignored_Tok) is record
      case ID is
         when Int_Tok =>
            Int_Val : Mal_Integer;
         when Float_Tok =>
            Float_Val : Mal_Float;
         when Str_Tok | Sym_Tok =>
            Start_Char, Stop_Char : Natural;
         when others => null;
      end case;
   end record;

   Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps.To_Set
       (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma);

   -- [^\s\[\]{}('"`,;)]
   Terminator_Syms : Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps."or"
       (Lisp_Whitespace, 
        Ada.Strings.Maps.To_Set ("[]{}('""`,;)"));

   -- The unterminated string error
   String_Error : exception;


   function Convert_String (S : String) return String is
      use Ada.Strings.Unbounded;
      Res : Unbounded_String;
      I : Positive;
      Str_Last : Natural;
   begin
      Str_Last := S'Last;
      I := S'First;
      while I <= Str_Last loop
         if S (I) = '\' then
            if I+1 > Str_Last then
               Append (Res, S (I));
               I := I + 1;
            elsif S (I+1) = 'n' then
               Append (Res, Ada.Characters.Latin_1.LF);
               I := I + 2;
            elsif S (I+1) = '"' then
               Append (Res, S (I+1));
               I := I + 2;
            elsif S (I+1) = '\' then
               Append (Res, S (I+1));
               I := I + 2;
            else
               Append (Res, S (I));
               I := I + 1;
            end if;
         else
            Append (Res, S (I));
            I := I + 1;
         end if;
      end loop;
      return To_String (Res);
   end Convert_String;

   Str_Len : Natural := 0;
   Saved_Line : Ada.Strings.Unbounded.Unbounded_String;
   Char_To_Read : Natural := 1;

   function Get_Token return Token is
      Res : Token;
      I, J : Natural;
      use Ada.Strings.Unbounded;
   begin

      <<Tail_Call_Opt>>

      -- Skip over whitespace...
      I := Char_To_Read;
      while I <= Str_Len and then
            Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop
         I := I + 1;
      end loop;

      -- Filter out lines consisting of only whitespace
      if I > Str_Len then
         return (ID => Ignored_Tok);
      end if;

      J := I;

      case Element (Saved_Line, J) is

         when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1;

         when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1;

         when '~' => -- Tilde

            if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then
               Res := (ID => Splice_Unq_Tok);
               Char_To_Read := J+2;
            else
               -- Just a Tilde
               Res := (ID => Unquote_Tok);
               Char_To_Read := J+1;
            end if;

         when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1;
         when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1;
         when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1;

         when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1;
         when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1;

         when ']' | '}' | ')' =>
            
            Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J);
            Char_To_Read := J+1;

         when '"' => -- a string

            -- Skip over "
            J := J + 1;
            while J <= Str_Len and then
               (Element (Saved_Line, J) /= '"' or else
                 Element (Saved_Line, J-1) = '\') loop
               J := J + 1;
            end loop;

            -- So we either ran out of string..
            if J > Str_Len then
               raise String_Error;
            end if;

            -- or we reached an unescaped "
            Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J);
            Char_To_Read := J + 1;

         when ';' => -- a comment

            -- Read to the end of the line or until
            -- the saved_line string is exhausted.
            -- NB if we reach the end we don't care
            -- what the last char was.
            while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop
               J := J + 1;
            end loop;
            if J = Str_Len then
               Res := (ID => Ignored_Tok);
            else
               Char_To_Read := J + 1;
               -- was: Res := Get_Token;
               goto Tail_Call_Opt;
            end if;

         when others => -- an atom

            while J <= Str_Len and then
               not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop
               J := J + 1;
            end loop;

            -- Either we ran out of string or
            -- the one at J was the start of a new token
            Char_To_Read := J;
            J := J - 1;

            declare
               Dots : Natural;
               All_Digits : Boolean;
            begin
               -- check if all digits or .
               Dots := 0;
               All_Digits := True;
               for K in I .. J loop
                  if Element (Saved_Line, K) = '.' then
                     Dots := Dots + 1; 
                  elsif not (Element (Saved_Line, K) in '0' .. '9') then
                     All_Digits := False;
                     exit;
                  end if;
               end loop;

               if All_Digits then
                  if Dots = 0 then
                     Res :=
                       (ID => Int_Tok,
                        Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J)));
                  elsif Dots = 1 then
                     Res :=
                       (ID => Float_Tok,
                        Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J)));
                  else
                     Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
                  end if;
               else
                  Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);<commit_msg>Ada: negative numbers in reader<commit_after>with Ada.IO_Exceptions;
with Ada.Characters.Latin_1;
with Ada.Exceptions;
with Ada.Strings.Maps.Constants;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with Smart_Pointers;
with Types.Vector;
with Types.Hash_Map;

package body Reader is

   use Types;

   package ACL renames Ada.Characters.Latin_1;

   type Lexemes is (Ignored_Tok,
                    Start_List_Tok, Start_Vector_Tok, Start_Hash_Tok,
                    Meta_Tok, Deref_Tok,
                    Quote_Tok, Quasi_Quote_Tok, Splice_Unq_Tok, Unquote_Tok,
                    Int_Tok, Float_Tok,
                    Str_Tok, Sym_Tok);

   type Token (ID : Lexemes := Ignored_Tok) is record
      case ID is
         when Int_Tok =>
            Int_Val : Mal_Integer;
         when Float_Tok =>
            Float_Val : Mal_Float;
         when Str_Tok | Sym_Tok =>
            Start_Char, Stop_Char : Natural;
         when others => null;
      end case;
   end record;

   Lisp_Whitespace : constant Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps.To_Set
       (ACL.HT & ACL.LF & ACL.CR & ACL.Space & ACL.Comma);

   -- [^\s\[\]{}('"`,;)]
   Terminator_Syms : Ada.Strings.Maps.Character_Set :=
     Ada.Strings.Maps."or"
       (Lisp_Whitespace, 
        Ada.Strings.Maps.To_Set ("[]{}('""`,;)"));

   -- The unterminated string error
   String_Error : exception;


   function Convert_String (S : String) return String is
      use Ada.Strings.Unbounded;
      Res : Unbounded_String;
      I : Positive;
      Str_Last : Natural;
   begin
      Str_Last := S'Last;
      I := S'First;
      while I <= Str_Last loop
         if S (I) = '\' then
            if I+1 > Str_Last then
               Append (Res, S (I));
               I := I + 1;
            elsif S (I+1) = 'n' then
               Append (Res, Ada.Characters.Latin_1.LF);
               I := I + 2;
            elsif S (I+1) = '"' then
               Append (Res, S (I+1));
               I := I + 2;
            elsif S (I+1) = '\' then
               Append (Res, S (I+1));
               I := I + 2;
            else
               Append (Res, S (I));
               I := I + 1;
            end if;
         else
            Append (Res, S (I));
            I := I + 1;
         end if;
      end loop;
      return To_String (Res);
   end Convert_String;

   Str_Len : Natural := 0;
   Saved_Line : Ada.Strings.Unbounded.Unbounded_String;
   Char_To_Read : Natural := 1;

   function Get_Token return Token is
      Res : Token;
      I, J : Natural;
      use Ada.Strings.Unbounded;
   begin

      <<Tail_Call_Opt>>

      -- Skip over whitespace...
      I := Char_To_Read;
      while I <= Str_Len and then
            Ada.Strings.Maps.Is_In (Element (Saved_Line, I), Lisp_Whitespace) loop
         I := I + 1;
      end loop;

      -- Filter out lines consisting of only whitespace
      if I > Str_Len then
         return (ID => Ignored_Tok);
      end if;

      J := I;

      case Element (Saved_Line, J) is

         when ''' => Res := (ID => Quote_Tok); Char_To_Read := J+1;

         when '`' => Res := (ID => Quasi_Quote_Tok); Char_To_Read := J+1;

         when '~' => -- Tilde

            if J+1 <= Str_Len and then Element (Saved_Line, J+1) = '@' then
               Res := (ID => Splice_Unq_Tok);
               Char_To_Read := J+2;
            else
               -- Just a Tilde
               Res := (ID => Unquote_Tok);
               Char_To_Read := J+1;
            end if;

         when '(' => Res := (ID => Start_List_Tok); Char_To_Read := J+1;
         when '[' => Res := (ID => Start_Vector_Tok); Char_To_Read := J+1;
         when '{' => Res := (ID => Start_Hash_Tok); Char_To_Read := J+1;

         when '^' => Res := (ID => Meta_Tok); Char_To_Read := J+1;
         when '@' => Res := (ID => Deref_Tok); Char_To_Read := J+1;

         when ']' | '}' | ')' =>
            
            Res := (ID => Sym_Tok, Start_Char => J, Stop_Char => J);
            Char_To_Read := J+1;

         when '"' => -- a string

            -- Skip over "
            J := J + 1;
            while J <= Str_Len and then
               (Element (Saved_Line, J) /= '"' or else
                 Element (Saved_Line, J-1) = '\') loop
               J := J + 1;
            end loop;

            -- So we either ran out of string..
            if J > Str_Len then
               raise String_Error;
            end if;

            -- or we reached an unescaped "
            Res := (ID => Str_Tok, Start_Char => I, Stop_Char => J);
            Char_To_Read := J + 1;

         when ';' => -- a comment

            -- Read to the end of the line or until
            -- the saved_line string is exhausted.
            -- NB if we reach the end we don't care
            -- what the last char was.
            while J < Str_Len and Element (Saved_Line, J) /= ACL.LF loop
               J := J + 1;
            end loop;
            if J = Str_Len then
               Res := (ID => Ignored_Tok);
            else
               Char_To_Read := J + 1;
               -- was: Res := Get_Token;
               goto Tail_Call_Opt;
            end if;

         when others => -- an atom

            while J <= Str_Len and then
               not Ada.Strings.Maps.Is_In (Element (Saved_Line, J), Terminator_Syms) loop
               J := J + 1;
            end loop;

            -- Either we ran out of string or
            -- the one at J was the start of a new token
            Char_To_Read := J;
            J := J - 1;

            declare
               Dots : Natural;
               All_Digits : Boolean;
            begin
               -- check if all digits or .
               Dots := 0;
               All_Digits := True;
               for K in I .. J loop
                  if (K = I and K /= J) and then Element (Saved_Line, K) = '-' then
                     null;
                  elsif Element (Saved_Line, K) = '.' then
                     Dots := Dots + 1; 
                  elsif not (Element (Saved_Line, K) in '0' .. '9') then
                     All_Digits := False;
                     exit;
                  end if;
               end loop;

               if All_Digits then
                  if Dots = 0 then
                     Res :=
                       (ID => Int_Tok,
                        Int_Val => Mal_Integer'Value (Slice (Saved_Line, I, J)));
                  elsif Dots = 1 then
                     Res :=
                       (ID => Float_Tok,
                        Float_Val => Mal_Float'Value (Slice (Saved_Line, I, J)));
                  else
                     Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
                  end if;
               else
                  Res := (ID => Sym_Tok, Start_Char => I, Stop_Char => J);
{'fraction_non_alphanumeric': 0.11505344418052256, 'fraction_numerical': 0.006532066508313539, 'mean_word_length': 1.2956210598057591, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 99, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '175675', 'n_tokens_mistral': 4294, 'n_tokens_neox': 4026, 'n_words': 1210}