Natools

-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar.Formatting;
with Ada.Calendar.Time_Zones;
with Ada.Characters.Handling;
with Ada.Containers.Indefinite_Doubly_Linked_Lists;
with Ada.Directories;
with Ada.Text_IO;

with GNAT.Perfect_Hash_Generators;

package body Natools.Static_Hash_Maps is

   package String_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists
     (String);


   procedure Add_Categorization
     (Path : in String;
      Categorization : in Package_Categorization);

   function File_Name (Package_Name : in String) return String;
      --  Convert a package name into a file name, the GNAT way

   function Image (Pos : Natural) return String;
      --  Trimmed image, for suffix construction

   function Image (Offset : Ada.Calendar.Time_Zones.Time_Offset) return String;

   procedure Put_Categorization
     (Output : in Ada.Text_IO.File_Type;
      Categorization : in Package_Categorization;
      Name : in String := "");

   procedure Write_Map_Body
     (Map : in Map_Description;
      Prefix : in String;
      File : in Ada.Text_IO.File_Type);
   procedure Write_Map_Hash_Package (Map : in Map_Description);
   procedure Write_Map_Private_Spec

      File : in Ada.Text_IO.File_Type);
      --  Output test loop for the hash function


   ------------------------
   -- Package Generators --
   ------------------------

   procedure Add_Categorization
     (Path : in String;
      Categorization : in Package_Categorization)
   is
      File : Ada.Text_IO.File_Type;
      Matches : Natural := 0;
      Contents : String_Lists.List;
   begin
      if Categorization = Default_Categorization then
         return;
      end if;

      Ada.Text_IO.Open (File, Ada.Text_IO.In_File, Path);
      while not Ada.Text_IO.End_Of_File (File) loop
         Contents.Append (Ada.Text_IO.Get_Line (File));
      end loop;
      Ada.Text_IO.Close (File);

      Ada.Text_IO.Open (File, Ada.Text_IO.Out_File, Path);
      for Line of Contents loop
         Ada.Text_IO.Put_Line (File, Line);

         if Line'Length >= 8
           and then Line (Line'First .. Line'First + 7) = "package "
           and then Line (Line'Last - 2 .. Line'Last) = " is"
         then
            Matches := Matches + 1;
            Put_Categorization (File, Categorization);
         end if;
      end loop;
      Ada.Text_IO.Close (File);

      pragma Assert (Matches = 1);
   end Add_Categorization;


   function File_Name (Package_Name : in String) return String is
      Result : String := Ada.Characters.Handling.To_Lower (Package_Name);
   begin
      for I in Result'Range loop
         if Result (I) = '.' then
            Result (I) := '-';

      return String'(1 => Sign,
         2 => Character'Val (48 + H / 10),
         3 => Character'Val (48 + H mod 10),
         4 => Character'Val (48 + M / 10),
         5 => Character'Val (48 + M mod 10));
   end Image;


   procedure Put_Categorization
     (Output : in Ada.Text_IO.File_Type;
      Categorization : in Package_Categorization;
      Name : in String := "")
   is
      function Prefix return String;
      function Suffix return String;

      function Prefix return String is
      begin
         if Name = "" then
            return "   pragma ";
         else
            return "pragma ";
         end if;
      end Prefix;

      function Suffix return String is
      begin
         if Name = "" then
            return "";
         else
            return " (" & Name & ')';
         end if;
      end Suffix;
   begin
      case Categorization is
         when Pure =>
            Ada.Text_IO.Put_Line (Output, Prefix & "Pure" & Suffix & ';');
         when Preelaborate =>
            Ada.Text_IO.Put_Line
              (Output, Prefix & "Preelaborate" & Suffix & ';');
         when Default_Categorization =>
            null;
      end case;
   end Put_Categorization;


   procedure Write_Map_Body
     (Map : in Map_Description;
      Prefix : in String;
      File : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line

      procedure Process (Element : in Map_Description) is
         Prefix : constant String := "Map_" & Image (Map_Pos + 1);
      begin
         case Current_Stage is
            when Hash_Package =>
               Write_Map_Hash_Package (Element);
               Add_Categorization
                 (Ada.Directories.Compose
                    ("",
                     File_Name (To_String (Element.Hash_Package_Name)),
                     "ads"),
                  Pkg.Categorization);
            when Public_Spec =>
               Write_Map_Public_Spec (Element, Spec_File);
            when Private_Spec =>
               Ada.Text_IO.New_Line (Spec_File);
               Write_Map_Private_Spec (Element, Prefix, Spec_File);
            when Body_With =>
               Write_Map_With (Element, Body_File);

            Name : constant String
              := To_String (Pkg.Name)
               & '.'
               & To_String (Pkg.Test_Child);
         begin
            Ada.Text_IO.Put_Line (Spec_File, "function " & Name);
            Ada.Text_IO.Put_Line (Spec_File, "  return Boolean;");
            Put_Categorization (Spec_File, Pkg.Categorization, Name);

            Current_Stage := Body_With;
            Map_Pos := 0;
            Pkg.Maps.Iterate (Query'Access);

            Ada.Text_IO.Put_Line (Body_File, "function " & Name);
            Ada.Text_IO.Put_Line (Body_File, "  return Boolean is");

      end if;

      if Pkg.Priv then
         Ada.Text_IO.Put (Spec_File, "private ");
      end if;
      Ada.Text_IO.Put_Line
        (Spec_File, "package " & To_String (Pkg.Name) & " is");
      Put_Categorization (Spec_File, Pkg.Categorization);
      Ada.Text_IO.New_Line (Spec_File);

      declare
         Declarations : constant String := To_String (Pkg.Extra_Declarations);
      begin
         if Declarations'Length > 0 then
            Ada.Text_IO.Put_Line (Spec_File, Declarations);

   procedure Close (Self : in out Map_Package) is
   begin
      Self.Name := Hold ("");
      Self.Maps.Clear;
   end Close;


   procedure Set_Categorization
     (Self : in out Map_Package;
      Categorization : in Package_Categorization) is
   begin
      Self.Categorization := Categorization;
   end Set_Categorization;


   procedure Set_Description
     (Self : in out Map_Package;
      Description : in String) is
   begin
      Self.Description := Hold (Description);
   end Set_Description;

      for I in Maps'Range loop
         Add_Map (Object, Maps (I));
      end loop;
      Commit (Object);
   end Generate_Package;

end Natools.Static_Hash_Maps;

------------------------------------------------------------------------------

private with Ada.Strings.Unbounded;
private with Ada.Containers.Doubly_Linked_Lists;

package Natools.Static_Hash_Maps is

   type Package_Categorization is (Pure, Preelaborate, Default_Categorization);

   type Map_Node is private;

   function Node (Key, Name : String) return Map_Node;

   type Node_Array is array (Positive range <>) of Map_Node;

   type Map_Description is private;

   procedure Open
     (Self : in out Map_Package;
      Name : in String;
      Private_Child : in Boolean := False);
      --  Reset Self and initialize it with the givan package Name

   procedure Set_Categorization
     (Self : in out Map_Package;
      Categorization : in Package_Categorization);

   procedure Set_Description
     (Self : in out Map_Package;
      Description : in String);

   procedure Set_Extra_Declarations
     (Self : in out Map_Package;
      Declarations : in String);

   package Map_Lists is new Ada.Containers.Doubly_Linked_Lists
     (Map_Description);

   type Map_Package is record
      Name : String_Holder;
      Categorization : Package_Categorization := Default_Categorization;
      Description : String_Holder;
      Extra_Declarations : String_Holder;
      Test_Child : String_Holder;
      Priv : Boolean;
      Maps : Map_Lists.List;
   end record;

end Natools.Static_Hash_Maps;