Natools

------------------------------------------------------------------------------
-- Copyright (c) 2016-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --

with Natools.Getopt_Long;
with Natools.Parallelism;
with Natools.S_Expressions.Parsers;
with Natools.S_Expressions.Printers;
with Natools.Smaz;
with Natools.Smaz.Tools;
with Natools.Smaz_256;
with Natools.Smaz_4096;
with Natools.Smaz_64;
with Natools.Smaz_Generic.Tools;
with Natools.Smaz_Implementations.Base_4096;
with Natools.Smaz_Implementations.Base_64_Tools;
with Natools.Smaz_Tools;
with Natools.Smaz_Tools.GNAT;
with Natools.String_Escapes;

procedure Smaz is
   function To_SEA (S : String) return Ada.Streams.Stream_Element_Array
     renames Natools.S_Expressions.To_Atom;

   package Tools_256 is new Natools.Smaz_256.Tools;
   package Tools_4096 is new Natools.Smaz_4096.Tools;
   package Tools_64 is new Natools.Smaz_64.Tools;

   package Methods renames Natools.Smaz_Tools.Methods;

   package Actions is
      type Enum is
        (Nothing,
         Decode,
         Encode,
         Evaluate);
   end Actions;

   package Algorithms is
      type Enum is
        (Base_256,
         Base_4096,
         Base_64,
         Base_256_Retired);
   end Algorithms;

   package Dict_Sources is
      type Enum is
        (S_Expression,
         Text_List,
         Unoptimized_Text_List);
   end Dict_Sources;

   package Options is
      type Id is
        (Base_256,
         Base_4096,
         Base_64,
         Output_Ada_Dict,
         Check_Roundtrip,
         Dictionary_Input,
         Decode,
         Encode,
         Evaluate,

     (Handler  : in out Callback;
      Argument : in String)
     is null;


   function Activate_Dictionary (Dict : in Natools.Smaz_256.Dictionary)
     return Natools.Smaz_256.Dictionary;
   function Activate_Dictionary (Dict : in Natools.Smaz_4096.Dictionary)
     return Natools.Smaz_4096.Dictionary;
   function Activate_Dictionary (Dict : in Natools.Smaz_64.Dictionary)
     return Natools.Smaz_64.Dictionary;
   function Activate_Dictionary (Dict : in Natools.Smaz.Dictionary)
     return Natools.Smaz.Dictionary;
      --  Update Dictionary.Hash so that it can be actually used

   procedure Build_Perfect_Hash

   function Getopt_Config return Getopt.Configuration;
      --  Build the configuration object

   function Last_Code (Dict : in Natools.Smaz_256.Dictionary)
     return Ada.Streams.Stream_Element
     is (Dict.Last_Code);
   function Last_Code (Dict : in Natools.Smaz_4096.Dictionary)
     return Natools.Smaz_Implementations.Base_4096.Base_4096_Digit
     is (Dict.Last_Code);
   function Last_Code (Dict : in Natools.Smaz_64.Dictionary)
     return Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit
     is (Dict.Last_Code);
   function Last_Code (Dict : in Natools.Smaz.Dictionary)
     return Ada.Streams.Stream_Element
     is (Dict.Dict_Last);
      --  Return the last valid entry

   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz_256.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz_4096.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz_64.Dictionary;
      Hash_Package_Name : in String := "");
   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz.Dictionary;
      Hash_Package_Name : in String := "");

      Score_Frequency => Tools_256.Score_Frequency'Access,
      Score_Gain => Tools_256.Score_Gain'Access,
      Simple_Dictionary => Natools.Smaz_Tools.Simple_Dictionary,
      Simple_Dictionary_And_Pending
        => Natools.Smaz_Tools.Simple_Dictionary_And_Pending,
      To_Dictionary => Tools_256.To_Dictionary,
      Worst_Element => Tools_256.Worst_Index);

   package Dict_4096 is new Dictionary_Subprograms
     (Dictionary => Natools.Smaz_4096.Dictionary,
      Dictionary_Entry
        => Natools.Smaz_Implementations.Base_4096.Base_4096_Digit,
      Methods => Natools.Smaz_Tools.Methods.Enum,
      Score_Value => Natools.Smaz_Tools.Score_Value,
      String_Count => Natools.Smaz_Tools.String_Count,
      Word_Counter => Natools.Smaz_Tools.Word_Counter,
      Dictionary_Counts => Tools_4096.Dictionary_Counts,
      String_Lists => Natools.Smaz_Tools.String_Lists,
      Add_Substrings => Natools.Smaz_Tools.Add_Substrings,
      Add_Words => Natools.Smaz_Tools.Add_Words,
      Append_String => Tools_4096.Append_String,
      Build_Perfect_Hash => Natools.Smaz_Tools.GNAT.Build_Perfect_Hash,
      Compress => Natools.Smaz_4096.Compress,
      Decompress => Natools.Smaz_4096.Decompress,
      Dict_Entry => Natools.Smaz_4096.Dict_Entry,
      Evaluate_Dictionary => Tools_4096.Evaluate_Dictionary,
      Evaluate_Dictionary_Partial => Tools_4096.Evaluate_Dictionary_Partial,
      Filter_By_Count => Natools.Smaz_Tools.Filter_By_Count,
      Last_Code => Last_Code,
      Remove_Element => Tools_4096.Remove_Element,
      Score_Encoded => Tools_4096.Score_Encoded'Access,
      Score_Frequency => Tools_4096.Score_Frequency'Access,
      Score_Gain => Tools_4096.Score_Gain'Access,
      Simple_Dictionary => Natools.Smaz_Tools.Simple_Dictionary,
      Simple_Dictionary_And_Pending
        => Natools.Smaz_Tools.Simple_Dictionary_And_Pending,
      To_Dictionary => Tools_4096.To_Dictionary,
      Worst_Element => Tools_4096.Worst_Index);

   package Dict_64 is new Dictionary_Subprograms
     (Dictionary => Natools.Smaz_64.Dictionary,
      Dictionary_Entry
        => Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit,
      Methods => Natools.Smaz_Tools.Methods.Enum,
      Score_Value => Natools.Smaz_Tools.Score_Value,

         when Options.Base_256_Retired =>
            Handler.Algorithm := Algorithms.Base_256_Retired;

         when Options.Base_64 =>
            Handler.Algorithm := Algorithms.Base_64;

         when Options.Base_4096 =>
            Handler.Algorithm := Algorithms.Base_4096;

         when Options.Check_Roundtrip =>
            Handler.Check_Roundtrip := True;
      end case;
   end Option;


   function Activate_Dictionary (Dict : in Natools.Smaz_256.Dictionary)
     return Natools.Smaz_256.Dictionary
   is
      Result : Natools.Smaz_256.Dictionary := Dict;
   begin
      Natools.Smaz_Tools.Set_Dictionary_For_Trie_Search
        (Tools_256.To_String_List (Result));
      Result.Hash := Natools.Smaz_Tools.Trie_Search'Access;

      pragma Assert (Natools.Smaz_256.Is_Valid (Result));

      return Result;
   end Activate_Dictionary;


   function Activate_Dictionary (Dict : in Natools.Smaz_4096.Dictionary)
     return Natools.Smaz_4096.Dictionary
   is
      Result : Natools.Smaz_4096.Dictionary := Dict;
   begin
      Natools.Smaz_Tools.Set_Dictionary_For_Trie_Search
        (Tools_4096.To_String_List (Result));
      Result.Hash := Natools.Smaz_Tools.Trie_Search'Access;

      pragma Assert (Natools.Smaz_4096.Is_Valid (Result));

      return Result;
   end Activate_Dictionary;


   function Activate_Dictionary (Dict : in Natools.Smaz_64.Dictionary)
     return Natools.Smaz_64.Dictionary
   is

   function Getopt_Config return Getopt.Configuration is
      use Getopt;
      use Options;
      R : Getopt.Configuration;
   begin
      R.Add_Option ("base-256",      '2', No_Argument,       Base_256);
      R.Add_Option ("base-4096",     '4', No_Argument,       Base_4096);
      R.Add_Option ("base-64",       '6', No_Argument,       Base_64);
      R.Add_Option ("ada-dict",      'A', Optional_Argument, Output_Ada_Dict);
      R.Add_Option ("check",         'C', No_Argument,       Check_Roundtrip);
      R.Add_Option ("decode",        'd', No_Argument,       Decode);
      R.Add_Option ("dict",          'D', No_Argument,       Dictionary_Input);
      R.Add_Option ("encode",        'e', No_Argument,       Encode);
      R.Add_Option ("evaluate",      'E', No_Argument,       Evaluate);

      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Tools_256.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;
   end Print_Dictionary;


   procedure Print_Dictionary
     (Output : in Ada.Text_IO.File_Type;
      Dictionary : in Natools.Smaz_4096.Dictionary;
      Hash_Package_Name : in String := "")
   is
      procedure Put_Line (Line : in String);

      procedure Put_Line (Line : in String) is
      begin
         Ada.Text_IO.Put_Line (Output, Line);
      end Put_Line;

      procedure Print_Dictionary_In_Ada is
        new Tools_4096.Print_Dictionary_In_Ada (Put_Line);
   begin
      if Hash_Package_Name'Length > 0 then
         Print_Dictionary_In_Ada
           (Dictionary,
            Hash_Image => Hash_Package_Name & ".Hash'Access");
      else
         Print_Dictionary_In_Ada (Dictionary);
      end if;

                 & "Use retired base-256 implementation");

            when Options.Base_64 =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Use base-64 implementation");

            when Options.Base_4096 =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Use base-4096 implementation");

            when Options.Check_Roundtrip =>
               New_Line (Output);
               Put_Line (Output, Indent & Indent
                 & "Check roundtrip of compression or decompression");
         end case;
      end loop;
   end Print_Help;

   case Handler.Algorithm is
      when Algorithms.Base_256 =>
         Dict_256.Process
           (Handler, Input_List, Input_Data, Handler.Score_Method);
      when Algorithms.Base_64 =>
         Dict_64.Process
           (Handler, Input_List, Input_Data, Handler.Score_Method);
      when Algorithms.Base_4096 =>
         Dict_4096.Process
           (Handler, Input_List, Input_Data, Handler.Score_Method);
      when Algorithms.Base_256_Retired =>
         declare
            Converted_Input_List : Natools.Smaz.Tools.String_Lists.List;
            Converted_Input_Data : Natools.Smaz.Tools.String_Lists.List;
         begin
            Convert (Input_List, Converted_Input_List);