-----------------------------------------------------------------------
--  gperfhash -- Perfect hash Ada generator
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;

with Ada.Command_Line;
with GNAT.Command_Line;
with GNAT.Perfect_Hash_Generators;

with Util.Log.Loggers;
with Util.Files;
with Util.Strings.Vectors;
with Util.Strings.Transforms;

--  This simple utility is an Ada perfect hash generator.  Given a fixed set of keywords,
--  it generates an Ada package (spec and body) which provides a perfect hash function.
--  The perfect hash algorithm is in fact provided by GNAT Perfect_Hash_Generators package.
procedure Gperfhash is

   use Util.Log.Loggers;
   use Ada.Strings.Unbounded;
   use GNAT.Command_Line;
   use Ada.Text_IO;

   --  Read a keyword and add it in the keyword list.
   procedure Read_Keyword (Line : in String);

   --  Given a package name, return the file name that correspond.
   function To_File_Name (Name : in String) return String;

   procedure Generate_Keyword_Table (Into : in out Ada.Text_IO.File_Type);

   --  Generate the package specification.
   procedure Generate_Specs (Name : in String);

   --  Generate the package body.
   procedure Generate_Body (Name : in String);

   Log         : constant Logger := Create ("log", "samples/log4j.properties");

   Pkg_Name    : Unbounded_String := To_Unbounded_String ("gphash");
   Names       : Util.Strings.Vectors.Vector;

   --  When true, generate a perfect hash which ignores the case.
   Ignore_Case : Boolean := False;

   --  ------------------------------
   --  Generate the keyword table.
   --  ------------------------------
   procedure Generate_Keyword_Table (Into : in out Ada.Text_IO.File_Type) is

      Index : Integer := 0;

      procedure Print_Keyword (Pos : in Util.Strings.Vectors.Cursor);
      procedure Print_Table (Pos : in Util.Strings.Vectors.Cursor);

      --  ------------------------------
      --  Print a keyword as an Ada constant string.
      --  ------------------------------
      procedure Print_Keyword (Pos : in Util.Strings.Vectors.Cursor) is
         Name : constant String := Util.Strings.Vectors.Element (Pos);
      begin
         Put (Into, "   K_");
         Put (Into, Util.Strings.Image (Index));
         Set_Col (Into, 20);
         Put (Into, ": aliased constant String := """);
         Put (Into, Name);
         Put_Line (Into, """;");
         Index := Index + 1;
      end Print_Keyword;

      --  ------------------------------
      --  Build the keyword table.
      --  ------------------------------
      procedure Print_Table (Pos : in Util.Strings.Vectors.Cursor) is
         pragma Unreferenced (Pos);
      begin
         if Index > 0 then
            if Index mod 4 = 0 then
               Put_Line (Into, ",");
               Put (Into, "      ");
            else
               Put (Into, ", ");
            end if;
         end if;
         Put (Into, "K_");
         Put (Into, Util.Strings.Image (Index));
         Put (Into, "'Access");
         Index := Index + 1;
      end Print_Table;

   begin
      New_Line (Into);
      Put_Line (Into, "   type Name_Access is access constant String;");
      Put_Line (Into, "   type Keyword_Array is array (Natural range <>) of Name_Access;");
      Put_Line (Into, "   Keywords : constant Keyword_Array;");
      Put_Line (Into, "private");
      New_Line (Into);
      Names.Iterate (Print_Keyword'Access);
      New_Line (Into);

      Index := 0;
      Put_Line (Into, "   Keywords : constant Keyword_Array := (");
      Put (Into, "      ");
      Names.Iterate (Print_Table'Access);
      Put_Line (Into, ");");
   end Generate_Keyword_Table;

   --  ------------------------------
   --  Generate the package specification.
   --  ------------------------------
   procedure Generate_Specs (Name : in String) is
      File : Ada.Text_IO.File_Type;
      Path : constant String := To_File_Name (Name) & ".ads";
   begin
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.Out_File,
                        Name => Path);
      Put_Line (File, "--  Generated by gperfhash");
      Put (File, "package ");
      Put (File, To_String (Pkg_Name));
      Put_Line (File, " is");
      New_Line (File);
      Put_Line (File, "   function Hash (S : String) return Natural;");
      New_Line (File);
      Put_Line (File, "   --  Returns true if the string S is a keyword.");
      Put_Line (File, "   function Is_Keyword (S : in String) return Boolean;");
      Generate_Keyword_Table (File);
      Put      (File, "end ");
      Put      (File, To_String (Pkg_Name));
      Put      (File, ";");
      New_Line (File);
      Close    (File);
   end Generate_Specs;

   --  ------------------------------
   --  Generate the package body.
   --  ------------------------------
   procedure Generate_Body (Name : in String) is

      --  Read the generated body file.
      procedure Read_Body (Line : in String);

      Path  : constant String := To_File_Name (Name) & ".adb";
      File  : Ada.Text_IO.File_Type;
      Count : Natural;
      Lines : Util.Strings.Vectors.Vector;

      --  ------------------------------
      --  Read the generated body file.
      --  ------------------------------
      procedure Read_Body (Line : in String) is
      begin
         Lines.Append (Line);
      end Read_Body;

      procedure Generate_Char_Position is
         use GNAT.Perfect_Hash_Generators;

         V : Natural;
      begin
         Put (File, "     (");
         for I in 0 .. 255 loop
            if I >= Character'Pos ('a') and I <= Character'Pos ('z') then
               V := Value (Used_Character_Set, I - Character'Pos ('a') + Character'Pos ('A'));
            else
               V := GNAT.Perfect_Hash_Generators.Value (Used_Character_Set, I);
            end if;
            if I > 0 then
               if I mod 16 = 0 then
                  Put_Line (File, ",");
                  Put (File, "      ");
               else
                  Put (File, ", ");
               end if;
            end if;
            Put (File, Util.Strings.Image (V));
         end loop;
         Put_Line (File, ");");
      end Generate_Char_Position;

   begin
      Util.Files.Read_File (Path => Path, Process => Read_Body'Access);
      Count := Natural (Lines.Length);
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.Out_File,
                        Name => Path);
      Put_Line (File, "--  Generated by gperfhash");
      if Ignore_Case then
         Put_Line (File, "with Util.Strings.Transforms;");
      end if;
      for I in 1 .. Count loop
         declare
            L : constant String := Lines.Element (I);
         begin

            if Ignore_Case and I >= 6 and I <= 16 then
               if I = 6 then
                  Generate_Char_Position;
               end if;
            else
               Put_Line (File, L);
            end if;

            --  Generate the Is_Keyword function before the package end.
            if I = Count - 1 then
               Put_Line (File, "   --  Returns true if the string S is a keyword.");
               Put_Line (File, "   function Is_Keyword (S : in String) return Boolean is");
               Put_Line (File, "      H : constant Natural := Hash (S);");
               Put_Line (File, "   begin");
               if Ignore_Case then
                  Put_Line (File, "      return Keywords (H).all = "
                            & "Util.Strings.Transforms.To_Upper_Case (S);");
               else
                  Put_Line (File, "      return Keywords (H).all = S;");
               end if;
               Put_Line (File, "   end Is_Keyword;");
            end if;
         end;
      end loop;
      Close (File);
   end Generate_Body;

   --  ------------------------------
   --  Read a keyword and add it in the keyword list.
   --  ------------------------------
   procedure Read_Keyword (Line : in String) is
      use Ada.Strings;
      Word : String := Fixed.Trim (Line, Both);
   begin
      if Word'Length > 0 then
         if Ignore_Case then
            Word := Util.Strings.Transforms.To_Upper_Case (Word);
         end if;
         Names.Append (Word);
         GNAT.Perfect_Hash_Generators.Insert (Word);
      end if;
   end Read_Keyword;

   --  ------------------------------
   --  Given a package name, return the file name that correspond.
   --  ------------------------------
   function To_File_Name (Name : in String) return String is
      Result : String (Name'Range);
   begin
      for J in Name'Range loop
         if Name (J) in 'A' .. 'Z' then
            Result (J) := Character'Val (Character'Pos (Name (J))
              - Character'Pos ('A')
              + Character'Pos ('a'));

         elsif Name (J) = '.' then
            Result (J) := '-';

         else
            Result (J) := Name (J);
         end if;
      end loop;
      return Result;
   end To_File_Name;

begin
   --  Initialization is optional.  Get the log configuration by reading the property
   --  file 'samples/log4j.properties'.  The 'log.util' logger will use a DEBUG level
   --  and write the message in 'result.log'.
   Util.Log.Loggers.Initialize ("samples/log4j.properties");

   loop
      case Getopt ("h i p: package: help") is
         when ASCII.NUL =>
            exit;

         when 'i' =>
            Ignore_Case := True;

         when 'p' =>
            Pkg_Name := To_Unbounded_String (Parameter);

         when others =>
            raise GNAT.Command_Line.Invalid_Switch;
      end case;
   end loop;
   declare
      Keywords : constant String := Get_Argument;
      Pkg      : constant String := To_String (Pkg_Name);
      Count    : Natural := 0;
      K_2_V    : Float;
      V        : Natural;
      Seed     : constant Natural := 4321; --  Needed by the hash algorithm
   begin
      --  Read the keywords.
      Util.Files.Read_File (Path => Keywords, Process => Read_Keyword'Access);

      Count := Natural (Names.Length);
      if Count = 0 then
         Log.Error ("There is no keyword.");
         Ada.Command_Line.Set_Exit_Status (1);
         return;
      end if;

      --  Generate the perfect hash package.
      V := 2 * Count + 1;
      loop
         K_2_V := Float (V) / Float (Count);
         GNAT.Perfect_Hash_Generators.Initialize (Seed, K_2_V);
         begin
            GNAT.Perfect_Hash_Generators.Compute;
            exit;
         exception
            when GNAT.Perfect_Hash_Generators.Too_Many_Tries =>
               V := V + 1;
         end;
      end loop;
      GNAT.Perfect_Hash_Generators.Produce (Pkg);

      --  Override what GNAT generates to have a list of keywords and other operations.
      Generate_Specs (Pkg);
      Generate_Body (Pkg);
   end;

exception
   when GNAT.Command_Line.Invalid_Switch =>
      Log.Error ("Usage: gperfhash -i -p package keyword-file");
end Gperfhash;

-----------------------------------------------------------------------
--  gperfhash -- Perfect hash Ada generator
--  Copyright (C) 2011 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with Ada.IO_Exceptions;
with Ada.Command_Line;

with GNAT.Command_Line;
with GNAT.Perfect_Hash_Generators;

with Util.Log.Loggers;
with Util.Files;
with Util.Strings.Vectors;
with Util.Strings.Transforms;

--  This simple utility is an Ada perfect hash generator.  Given a fixed set of keywords,
--  it generates an Ada package (spec and body) which provides a perfect hash function.
--  The perfect hash algorithm is in fact provided by GNAT Perfect_Hash_Generators package.
--
--  Usage: gperfhash [-i] [-p package] keyword-file
--
--  -i           Generate a perfect hash which ignores the case
--  -p package   Use package as the name of package (default is gphash)
--  keyword-file The file which contains the keywords, one keyword on each line
procedure Gperfhash is

   use Util.Log.Loggers;
   use Ada.Strings.Unbounded;
   use GNAT.Command_Line;
   use Ada.Text_IO;

   --  Read a keyword and add it in the keyword list.
   procedure Read_Keyword (Line : in String);

   --  Given a package name, return the file name that correspond.
   function To_File_Name (Name : in String) return String;

   procedure Generate_Keyword_Table (Into : in out Ada.Text_IO.File_Type);

   --  Generate the package specification.
   procedure Generate_Specs (Name : in String);

   --  Generate the package body.
   procedure Generate_Body (Name : in String);

   Log         : constant Logger := Create ("log", "samples/log4j.properties");

   Pkg_Name    : Unbounded_String := To_Unbounded_String ("gphash");
   Names       : Util.Strings.Vectors.Vector;

   --  When true, generate a perfect hash which ignores the case.
   Ignore_Case : Boolean := False;

   --  ------------------------------
   --  Generate the keyword table.
   --  ------------------------------
   procedure Generate_Keyword_Table (Into : in out Ada.Text_IO.File_Type) is

      Index : Integer := 0;

      procedure Print_Keyword (Pos : in Util.Strings.Vectors.Cursor);
      procedure Print_Table (Pos : in Util.Strings.Vectors.Cursor);

      --  ------------------------------
      --  Print a keyword as an Ada constant string.
      --  ------------------------------
      procedure Print_Keyword (Pos : in Util.Strings.Vectors.Cursor) is
         Name : constant String := Util.Strings.Vectors.Element (Pos);
      begin
         Put (Into, "   K_");
         Put (Into, Util.Strings.Image (Index));
         Set_Col (Into, 20);
         Put (Into, ": aliased constant String := """);
         Put (Into, Name);
         Put_Line (Into, """;");
         Index := Index + 1;
      end Print_Keyword;

      --  ------------------------------
      --  Build the keyword table.
      --  ------------------------------
      procedure Print_Table (Pos : in Util.Strings.Vectors.Cursor) is
         pragma Unreferenced (Pos);
      begin
         if Index > 0 then
            if Index mod 4 = 0 then
               Put_Line (Into, ",");
               Put (Into, "      ");
            else
               Put (Into, ", ");
            end if;
         end if;
         Put (Into, "K_");
         Put (Into, Util.Strings.Image (Index));
         Put (Into, "'Access");
         Index := Index + 1;
      end Print_Table;

   begin
      New_Line (Into);
      Put_Line (Into, "   type Name_Access is access constant String;");
      Put_Line (Into, "   type Keyword_Array is array (Natural range <>) of Name_Access;");
      Put_Line (Into, "   Keywords : constant Keyword_Array;");
      Put_Line (Into, "private");
      New_Line (Into);
      Names.Iterate (Print_Keyword'Access);
      New_Line (Into);

      Index := 0;
      Put_Line (Into, "   Keywords : constant Keyword_Array := (");
      Put (Into, "      ");
      Names.Iterate (Print_Table'Access);
      Put_Line (Into, ");");
   end Generate_Keyword_Table;

   --  ------------------------------
   --  Generate the package specification.
   --  ------------------------------
   procedure Generate_Specs (Name : in String) is
      File : Ada.Text_IO.File_Type;
      Path : constant String := To_File_Name (Name) & ".ads";
   begin
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.Out_File,
                        Name => Path);
      Put_Line (File, "--  Generated by gperfhash");
      Put (File, "package ");
      Put (File, To_String (Pkg_Name));
      Put_Line (File, " is");
      New_Line (File);
      Put_Line (File, "   function Hash (S : String) return Natural;");
      New_Line (File);
      Put_Line (File, "   --  Returns true if the string S is a keyword.");
      Put_Line (File, "   function Is_Keyword (S : in String) return Boolean;");
      Generate_Keyword_Table (File);
      Put      (File, "end ");
      Put      (File, To_String (Pkg_Name));
      Put      (File, ";");
      New_Line (File);
      Close    (File);
   end Generate_Specs;

   --  ------------------------------
   --  Generate the package body.
   --  ------------------------------
   procedure Generate_Body (Name : in String) is

      --  Read the generated body file.
      procedure Read_Body (Line : in String);

      --  Re-generate the char position table to ignore the case.
      procedure Generate_Char_Position;

      Path  : constant String := To_File_Name (Name) & ".adb";
      File  : Ada.Text_IO.File_Type;
      Count : Natural;
      Lines : Util.Strings.Vectors.Vector;

      --  ------------------------------
      --  Read the generated body file.
      --  ------------------------------
      procedure Read_Body (Line : in String) is
      begin
         Lines.Append (Line);
      end Read_Body;

      --  ------------------------------
      --  Re-generate the char position table to ignore the case.
      --  ------------------------------
      procedure Generate_Char_Position is
         use GNAT.Perfect_Hash_Generators;

         V : Natural;
      begin
         Put (File, "     (");
         for I in 0 .. 255 loop
            if I >= Character'Pos ('a') and I <= Character'Pos ('z') then
               V := Value (Used_Character_Set, I - Character'Pos ('a') + Character'Pos ('A'));
            else
               V := GNAT.Perfect_Hash_Generators.Value (Used_Character_Set, I);
            end if;
            if I > 0 then
               if I mod 16 = 0 then
                  Put_Line (File, ",");
                  Put (File, "      ");
               else
                  Put (File, ", ");
               end if;
            end if;
            Put (File, Util.Strings.Image (V));
         end loop;
         Put_Line (File, ");");
      end Generate_Char_Position;

   begin
      Util.Files.Read_File (Path => Path, Process => Read_Body'Access);
      Count := Natural (Lines.Length);
      Ada.Text_IO.Open (File => File,
                        Mode => Ada.Text_IO.Out_File,
                        Name => Path);
      Put_Line (File, "--  Generated by gperfhash");
      if Ignore_Case then
         Put_Line (File, "with Util.Strings.Transforms;");
      end if;
      for I in 1 .. Count loop
         declare
            L : constant String := Lines.Element (I);
         begin
            --  Replace the char position table by ours.  The lower case letter are just
            --  mapped to the corresponding upper case letter.
            if Ignore_Case and I >= 6 and I <= 16 then
               if I = 6 then
                  Generate_Char_Position;
               end if;
            else
               Put_Line (File, L);
            end if;

            --  Generate the Is_Keyword function before the package end.
            if I = Count - 1 then
               Put_Line (File, "   --  Returns true if the string S is a keyword.");
               Put_Line (File, "   function Is_Keyword (S : in String) return Boolean is");
               Put_Line (File, "      H : constant Natural := Hash (S);");
               Put_Line (File, "   begin");
               if Ignore_Case then
                  Put_Line (File, "      return Keywords (H).all = "
                            & "Util.Strings.Transforms.To_Upper_Case (S);");
               else
                  Put_Line (File, "      return Keywords (H).all = S;");
               end if;
               Put_Line (File, "   end Is_Keyword;");
            end if;
         end;
      end loop;
      Close (File);
   end Generate_Body;

   --  ------------------------------
   --  Read a keyword and add it in the keyword list.
   --  ------------------------------
   procedure Read_Keyword (Line : in String) is
      use Ada.Strings;
      Word : String := Fixed.Trim (Line, Both);
   begin
      if Word'Length > 0 then
         if Ignore_Case then
            Word := Util.Strings.Transforms.To_Upper_Case (Word);
         end if;
         Names.Append (Word);
         GNAT.Perfect_Hash_Generators.Insert (Word);
      end if;
   end Read_Keyword;

   --  ------------------------------
   --  Given a package name, return the file name that correspond.
   --  ------------------------------
   function To_File_Name (Name : in String) return String is
      Result : String (Name'Range);
   begin
      for J in Name'Range loop
         if Name (J) in 'A' .. 'Z' then
            Result (J) := Character'Val (Character'Pos (Name (J))
              - Character'Pos ('A')
              + Character'Pos ('a'));

         elsif Name (J) = '.' then
            Result (J) := '-';

         else
            Result (J) := Name (J);
         end if;
      end loop;
      return Result;
   end To_File_Name;

begin
   --  Initialization is optional.  Get the log configuration by reading the property
   --  file 'samples/log4j.properties'.  The 'log.util' logger will use a DEBUG level
   --  and write the message in 'result.log'.
   Util.Log.Loggers.Initialize ("samples/log4j.properties");

   loop
      case Getopt ("h i p: package: help") is
         when ASCII.NUL =>
            exit;

         when 'i' =>
            Ignore_Case := True;

         when 'p' =>
            Pkg_Name := To_Unbounded_String (Parameter);

         when others =>
            raise GNAT.Command_Line.Invalid_Switch;
      end case;
   end loop;
   declare
      Keywords : constant String := Get_Argument;
      Pkg      : constant String := To_String (Pkg_Name);
      Count    : Natural := 0;
      K_2_V    : Float;
      V        : Natural;
      Seed     : constant Natural := 4321; --  Needed by the hash algorithm
   begin
      --  Read the keywords.
      Util.Files.Read_File (Path => Keywords, Process => Read_Keyword'Access);

      Count := Natural (Names.Length);
      if Count = 0 then
         Log.Error ("There is no keyword.");
         raise GNAT.Command_Line.Invalid_Switch;
      end if;

      --  Generate the perfect hash package.
      V := 2 * Count + 1;
      loop
         K_2_V := Float (V) / Float (Count);
         GNAT.Perfect_Hash_Generators.Initialize (Seed, K_2_V);
         begin
            GNAT.Perfect_Hash_Generators.Compute;
            exit;
         exception
            when GNAT.Perfect_Hash_Generators.Too_Many_Tries =>
               V := V + 1;
         end;
      end loop;
      GNAT.Perfect_Hash_Generators.Produce (Pkg);

      --  Override what GNAT generates to have a list of keywords and other operations.
      Generate_Specs (Pkg);
      Generate_Body (Pkg);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read the keyword file.");
         Ada.Command_Line.Set_Exit_Status (1);
   end;

exception
   when GNAT.Command_Line.Invalid_Switch =>
      Log.Error ("Usage: gperfhash -i -p package keyword-file");
      Log.Error ("-i           Generate a perfect hash which ignores the case");
      Log.Error ("-p package   Use 'package' as the name of package (default is 'gphash')");
      Log.Error ("keyword-file The file which contains the keywords, one keyword on each line");
      Ada.Command_Line.Set_Exit_Status (1);
end Gperfhash;

Add some error messages

Add some error messages


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                           A 4 G . A _ E L I S T S                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2007, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public License  distributed with ASIS-for-GNAT; see   file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adaccore.com).                                               --
--                                                                          --
------------------------------------------------------------------------------

--  This is the modification of the GNAT Elists package. See spec for the
--  description of the modifications.

with A4G.A_Debug;  use A4G.A_Debug;

with Output;       use Output;

package body A4G.A_Elists is

   ----------------------
   -- Add_To_Elmt_List --
   ----------------------

   procedure Add_To_Elmt_List (Unit : Unit_Id; List : in out Elist_Id) is
   begin
      if No (List) then
         List := New_Elmt_List;
         Append_Elmt (Unit, List);
      elsif not In_Elmt_List (Unit, List) then
         Append_Elmt (Unit, List);
      end if;
   end Add_To_Elmt_List;

   -----------------
   -- Append_Elmt --
   -----------------

   procedure Append_Elmt (Unit : Unit_Id; To : Elist_Id) is
      L : constant Elmt_Id := Elists.Table (To).Last;

   begin
      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Unit := Unit;
      Elmts.Table (Elmts.Last).Next := Union_Id (To);

      if L = No_Elmt then
         Elists.Table (To).First := Elmts.Last;
      else
         Elmts.Table (L).Next := Union_Id (Elmts.Last);
      end if;

      Elists.Table (To).Last  := Elmts.Last;

      if Debug_Flag_N then
         Write_Str ("Append new element Elmt_Id = ");
         Write_Int (Int (Elmts.Last));
         Write_Str (" to list Elist_Id = ");
         Write_Int (Int (To));
         Write_Str (" referencing Unit_Id = ");
         Write_Int (Int (Unit));
         Write_Eol;
      end if;
   end Append_Elmt;

   ------------------
   -- Prepend_Elmt --
   ------------------

   procedure Prepend_Elmt (Unit : Unit_Id; To : Elist_Id) is
      F : constant Elmt_Id := Elists.Table (To).First;

   begin
      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Unit := Unit;

      if F = No_Elmt then
         Elists.Table (To).Last := Elmts.Last;
         Elmts.Table (Elmts.Last).Next := Union_Id (To);
      else
         Elmts.Table (Elmts.Last).Next := Union_Id (F);
      end if;

      Elists.Table (To).First  := Elmts.Last;

   end Prepend_Elmt;

   -----------------------
   -- Insert_Elmt_After --
   -----------------------

   procedure Insert_Elmt_After (Unit : Unit_Id; Elmt : Elmt_Id) is
      N : constant Union_Id := Elmts.Table (Elmt).Next;

   begin

      pragma Assert (Elmt /= No_Elmt);

      Elmts.Increment_Last;
      Elmts.Table (Elmts.Last).Unit := Unit;
      Elmts.Table (Elmts.Last).Next := N;

      Elmts.Table (Elmt).Next := Union_Id (Elmts.Last);

      if N in Elist_Range then
         Elists.Table (Elist_Id (N)).Last := Elmts.Last;
      end if;
   end Insert_Elmt_After;

   -------------
   -- Belongs --
   -------------

   function Belongs (List1 : Elist_Id; List2 : Elist_Id) return Boolean is
      Curr_Elmt : Elmt_Id;
   begin
      if No (List1) or else Is_Empty_Elmt_List (List1) then
         return True;
      end if;

      Curr_Elmt := First_Elmt (List1);

      while Present (Curr_Elmt) loop
         if not In_Elmt_List (Unit (Curr_Elmt), List2) then
            return False;
         end if;
         Curr_Elmt := Next_Elmt (Curr_Elmt);
      end loop;

      return True;

   end Belongs;

   ----------------
   -- First_Elmt --
   ----------------

   function First_Elmt (List : Elist_Id) return Elmt_Id is
   begin
      pragma Assert (List > Elist_Low_Bound);
      return Elists.Table (List).First;
   end First_Elmt;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Elists.Init;
      Elmts.Init;
   end Initialize;

   ------------------
   -- In_Elmt_List --
   ------------------

   function In_Elmt_List (U : Unit_Id; List : Elist_Id) return Boolean is
      Curr_Elmt : Elmt_Id;
   begin
      if No (List) or else Is_Empty_Elmt_List (List) then
         return False;
      end if;

      Curr_Elmt := First_Elmt (List);
      while Present (Curr_Elmt) loop
         if U = Unit (Curr_Elmt) then
            return True;
         end if;
         Curr_Elmt := Next_Elmt (Curr_Elmt);
      end loop;

      return False;

   end In_Elmt_List;

   ---------------
   -- Intersect --
   ---------------

   function Intersect (List1 : Elist_Id; List2 : Elist_Id) return Boolean is
      Curr_Elmt : Elmt_Id;
   begin
      if No (List1) or else  No (List2) or else
         Is_Empty_Elmt_List (List1) or else
         Is_Empty_Elmt_List (List2)
      then
         return False;
      else
         Curr_Elmt := First_Elmt (List1);

         while Present (Curr_Elmt) loop
            if In_Elmt_List (Unit (Curr_Elmt), List2) then
               return True;
            end if;
            Curr_Elmt := Next_Elmt (Curr_Elmt);
         end loop;

         return False;
      end if;
   end Intersect;

   ------------------------
   -- Is_Empty_Elmt_List --
   ------------------------

   function Is_Empty_Elmt_List (List : Elist_Id) return Boolean is
   begin
      return Elists.Table (List).First = No_Elmt;
   end Is_Empty_Elmt_List;

   -------------------
   -- Last_Elist_Id --
   -------------------

   function Last_Elist_Id return Elist_Id is
   begin
      return Elists.Last;
   end Last_Elist_Id;

   ---------------
   -- Last_Elmt --
   ---------------

   function Last_Elmt (List : Elist_Id) return Elmt_Id is
   begin
      return Elists.Table (List).Last;
   end Last_Elmt;

   ------------------
   -- Last_Elmt_Id --
   ------------------

   function Last_Elmt_Id return Elmt_Id is
   begin
      return Elmts.Last;
   end Last_Elmt_Id;

   -----------------
   -- List_Length --
   -----------------

   function List_Length (List : Elist_Id) return Natural is
      Result : Natural := 0;
      Elem   : Elmt_Id;
   begin
      Elem := First_Elmt (List);

      while Present (Elem) loop
         Result := Result + 1;
         Elem   := Next_Elmt (Elem);
      end loop;

      return Result;
   end List_Length;

   ---------------
   -- Move_List --
   ---------------

   procedure Move_List
     (List_From :        Elist_Id;
      List_To   : in out Elist_Id)
   is
   begin
      if No (List_To) then
         List_To := New_Elmt_List;
      end if;

      if No (List_From) or else Is_Empty_Elmt_List (List_From) then
         return;
      end if;

      --  if we are here, we have to move elements...

      if Is_Empty_Elmt_List (List_To) then

         Elists.Table (List_To).Last  := Elists.Table (List_From).Last;
         Elmts.Table (Elists.Table (List_From).Last).Next :=
            Union_Id (List_To);

      else
         Elmts.Table (Elists.Table (List_From).Last).Next :=
            Elmts.Table (Elists.Table (List_To).First).Next;
      end if;

      Elists.Table (List_To).First := Elists.Table (List_From).First;

      Elists.Table (List_From).First := No_Elmt;
      Elists.Table (List_From).Last  := No_Elmt;

   end Move_List;

   -------------------
   -- New_Elmt_List --
   -------------------

   function New_Elmt_List return Elist_Id is
   begin
      Elists.Increment_Last;
      Elists.Table (Elists.Last).First := No_Elmt;
      Elists.Table (Elists.Last).Last  := No_Elmt;

      if Debug_Flag_N then
         Write_Str ("Allocate new element list, returned ID = ");
         Write_Int (Int (Elists.Last));
         Write_Eol;
      end if;

      return Elists.Last;
   end New_Elmt_List;

   ---------------
   -- Next_Elmt --
   ---------------

   function Next_Elmt (Elmt : Elmt_Id) return Elmt_Id is
      N : constant Union_Id := Elmts.Table (Elmt).Next;

   begin
      if N in Elist_Range then
         return No_Elmt;
      else
         return Elmt_Id (N);
      end if;
   end Next_Elmt;

   --------
   -- No --
   --------

   function No (List : Elist_Id) return Boolean is
   begin
      return List = No_Elist;
   end No;

   function No (Elmt : Elmt_Id) return Boolean is
   begin
      return Elmt = No_Elmt;
   end No;

   -----------
   -- Unit --
   -----------

   function Unit (Elmt : Elmt_Id) return Unit_Id is
   begin
      if Elmt = No_Elmt then
         return Nil_Unit;
      else
         return Elmts.Table (Elmt).Unit;
      end if;
   end Unit;

   ----------------
   -- Num_Elists --
   ----------------

   function Num_Elists return Nat is
   begin
      return Int (Elmts.Last) - Int (Elmts.First) + 1;
   end Num_Elists;

   -------------
   -- Present --
   -------------

   function Present (List : Elist_Id) return Boolean is
   begin
      return List /= No_Elist;
   end Present;

   function Present (Elmt : Elmt_Id) return Boolean is
   begin
      return Elmt /= No_Elmt;
   end Present;

   ----------------
   -- Print_List --
   ----------------

   procedure Print_List (List : Elist_Id) is
      Curr_Elmt : Elmt_Id;
      Counter   : Int := 1;
   begin
      if No (List) then
         if Debug_Flag_N then
            Write_Str ("   There is no list here");
            Write_Eol;
         end if;
         return;
      end if;

      if Is_Empty_Elmt_List (List) then
         if Debug_Flag_N then
            Write_Str ("   The list is empty");
            Write_Eol;
         end if;
         return;
      end if;

      if Debug_Flag_N then
         Write_Str ("List contains the following Ids:");
         Write_Eol;
      end if;

      Curr_Elmt := First_Elmt (List);
      while Present (Curr_Elmt) loop
         if Debug_Flag_N then
            Write_Str ("   Element number ");
            Write_Int (Counter);
            Write_Str (" is ");
            Write_Int (Int (Unit (Curr_Elmt)));
            Write_Eol;
         end if;
         Curr_Elmt := Next_Elmt (Curr_Elmt);
         Counter   := Counter + 1;
      end loop;

   end Print_List;

   -----------------
   -- Remove_Elmt --
   -----------------

   procedure Remove_Elmt (List : Elist_Id; Elmt : Elmt_Id) is
      Nxt : Elmt_Id;
      Prv : Elmt_Id;

   begin
      Nxt := Elists.Table (List).First;

      --  Case of removing only element in the list

      if Elmts.Table (Nxt).Next in Elist_Range then

         pragma Assert (Nxt = Elmt);

         Elists.Table (List).First := No_Elmt;
         Elists.Table (List).Last  := No_Elmt;

      --  Case of removing the first element in the list

      elsif Nxt = Elmt then
         Elists.Table (List).First := Elmt_Id (Elmts.Table (Nxt).Next);

      --  Case of removing second or later element in the list

      else
         loop
            Prv := Nxt;
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
            exit when Nxt = Elmt
              or else Elmts.Table (Nxt).Next in Elist_Range;
         end loop;

         pragma Assert (Nxt = Elmt);

         Elmts.Table (Prv).Next := Elmts.Table (Nxt).Next;

         if Elmts.Table (Prv).Next in Elist_Range then
            Elists.Table (List).Last := Prv;
         end if;
      end if;
   end Remove_Elmt;

   ----------------------
   -- Remove_Last_Elmt --
   ----------------------

   procedure Remove_Last_Elmt (List : Elist_Id) is
      Nxt : Elmt_Id;
      Prv : Elmt_Id;

   begin
      Nxt := Elists.Table (List).First;

      --  Case of removing only element in the list

      if Elmts.Table (Nxt).Next in Elist_Range then
         Elists.Table (List).First := No_Elmt;
         Elists.Table (List).Last  := No_Elmt;

      --  Case of at least two elements in list

      else
         loop
            Prv := Nxt;
            Nxt := Elmt_Id (Elmts.Table (Prv).Next);
            exit when Elmts.Table (Nxt).Next in Elist_Range;
         end loop;

         Elmts.Table (Prv).Next   := Elmts.Table (Nxt).Next;
         Elists.Table (List).Last := Prv;
      end if;
   end Remove_Last_Elmt;

   ------------------
   -- Replace_Elmt --
   ------------------

   procedure Replace_Elmt (Elmt : Elmt_Id; New_Unit : Unit_Id) is
   begin
      Elmts.Table (Elmt).Unit := New_Unit;
   end Replace_Elmt;

end A4G.A_Elists;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  mat-readers-streams -- Reader for streams
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams.Stream_IO;

with Util.Log.Loggers;
with MAT.Readers.Marshaller;
package body MAT.Readers.Streams is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Files");

   BUFFER_SIZE  : constant Natural := 100 * 1024;
   MAX_MSG_SIZE : constant Ada.Streams.Stream_Element_Offset := 2048;

   --  ------------------------------
   --  Read the events from the stream and stop when the end of the stream is reached.
   --  ------------------------------
   procedure Read_All (Reader : in out Stream_Reader_Type) is
      use Ada.Streams;
      use type MAT.Types.Uint8;

      Data    : aliased Ada.Streams.Stream_Element_Array (0 .. MAX_MSG_SIZE);
      Buffer  : aliased Buffer_Type;
      Msg     : Message;
      Last    : Ada.Streams.Stream_Element_Offset;
      Format  : MAT.Types.Uint8;
   begin
      Msg.Buffer := Buffer'Unchecked_Access;
      Msg.Buffer.Start := Data (0)'Address;
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last := Data (MAX_MSG_SIZE)'Address;
      Msg.Buffer.Size := 3;
      Reader.Stream.Read (Data (0 .. 2), Last);
      Format := MAT.Readers.Marshaller.Get_Uint8 (Msg.Buffer);
      if Format = 0 then
         Msg.Buffer.Endian := LITTLE_ENDIAN;
         Log.Debug ("Data stream is little endian");
      else
         Msg.Buffer.Endian := BIG_ENDIAN;
         Log.Debug ("Data stream is big endian");
      end if;
      Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
      if Msg.Size < 2 then
         Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
      end if;
      Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
      Msg.Buffer.Current := Msg.Buffer.Start;
      Msg.Buffer.Last    := Data (Last)'Address;
      Msg.Buffer.Size    := Msg.Size;
      Reader.Read_Headers (Msg);
      while not Reader.Stream.Is_Eof loop
         Reader.Stream.Read (Data (0 .. 1), Last);
         exit when Last /= 2;
         Msg.Buffer.Size := 2;
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Size := Natural (MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer));
         if Msg.Size < 2 then
            Log.Error ("Invalid message size {0}", Natural'Image (Msg.Size));
         end if;
         if Ada.Streams.Stream_Element_Offset (Msg.Size) >= Data'Last then
            Log.Error ("Message size {0} is too big", Natural'Image (Msg.Size));
            exit;
         end if;
         Reader.Stream.Read (Data (0 .. Ada.Streams.Stream_Element_Offset (Msg.Size - 1)), Last);
         Msg.Buffer.Current := Msg.Buffer.Start;
         Msg.Buffer.Last    := Data (Last)'Address;
         Msg.Buffer.Size    := Msg.Size;
         Reader.Dispatch_Message (Msg);
      end loop;
   end Read_All;

end MAT.Readers.Streams;

Implement the Read_All operation

Implement the Read_All operation


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                      A 4 G . A S I S _ T A B L E S                       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (C) 1995-2009, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A  PARTICULAR PURPOSE.  See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public  License  distributed with  ASIS-for-GNAT; see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences. ASIS-for-GNAT is now maintained by AdaCore                     --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

with Asis.Elements; use Asis.Elements;

with Atree;         use Atree;
with Sinput;        use Sinput;
with Einfo;         use Einfo;
with Nlists;        use Nlists;

package body A4G.Asis_Tables is

   ---------------------
   -- Add_New_Element --
   ---------------------

   procedure Add_New_Element (Element : Asis.Element) is
      Found : Boolean := False;
   begin
      for J in 1 .. Asis_Element_Table.Last loop
         if Is_Equal (Element, Asis_Element_Table.Table (J)) then
            Found := True;
            exit;
         end if;
      end loop;

      if not Found then
         Asis_Element_Table.Append (Element);
      end if;
   end Add_New_Element;

   -----------------------
   -- Create_Node_Trace --
   -----------------------

   procedure Create_Node_Trace (N : Node_Id) is
      Next_Node     : Node_Id;
      Next_Sloc     : Source_Ptr;
      Next_Node_Rec : Node_Trace_Rec;
   begin
      Node_Trace.Init;

      Next_Node := N;

      while Present (Next_Node) loop
         Next_Sloc := Sloc (Next_Node);

         Next_Node_Rec.Kind      := Nkind                    (Next_Node);
         Next_Node_Rec.Node_Line := Get_Physical_Line_Number (Next_Sloc);
         Next_Node_Rec.Node_Col  := Get_Column_Number        (Next_Sloc);

         Node_Trace.Append (Next_Node_Rec);

         Next_Node := Enclosing_Scope (Next_Node);
      end loop;

   end Create_Node_Trace;

   ---------------------
   -- Enclosing_Scope --
   ---------------------

   function Enclosing_Scope (N : Node_Id) return Node_Id is
      Result      : Node_Id := N;
      Entity_Node : Entity_Id := Empty;
   begin

      if Nkind (Result) = N_Package_Declaration then
         Entity_Node := Defining_Unit_Name (Sinfo.Specification (Result));
      elsif Nkind (Result) = N_Package_Body then
         Entity_Node := Defining_Unit_Name (Result);
      end if;

      if Nkind (Entity_Node) = N_Defining_Program_Unit_Name then
         Entity_Node := Sinfo.Defining_Identifier (Entity_Node);
      end if;

      if Present (Entity_Node) and then
         Is_Generic_Instance (Entity_Node)
      then
         --  going to the corresponding instantiation

         if Nkind (Parent (Result)) = N_Compilation_Unit then
            --  We are at the top/ and we do not need a library-level
            --  instantiation - it is always unique in the compilation
            --  unit
            Result := Empty;
         else
            --  "local" instantiation, therefore - one or two steps down the
            --  declaration list to get in the instantiation node:
            Result := Next_Non_Pragma (Result);

            if Nkind (Result) = N_Package_Body then
               --  This is an expanded generic body
               Result := Next_Non_Pragma (Result);
            end if;

         end if;

      else
         --  One step up to the enclosing scope
         Result := Parent (Result);

         while not (Nkind (Result) = N_Package_Specification or else
                    Nkind (Result) = N_Package_Body          or else
                    Nkind (Result) = N_Compilation_Unit      or else
                    Nkind (Result) = N_Subprogram_Body       or else
                    Nkind (Result) = N_Block_Statement)
         loop
            Result := Parent (Result);
         end loop;

         if Nkind (Result) = N_Package_Specification then
            Result := Parent (Result);

         elsif Nkind (Result) = N_Compilation_Unit then
            Result := Empty;
         end if;

      end if;

      return Result;
   end Enclosing_Scope;

   --------------
   -- Is_Equal --
   --------------

   function Is_Equal
     (N         : Node_Id;
      Trace_Rec : Node_Trace_Rec)
      return      Boolean
   is
   begin

      return Nkind (N)                           = Trace_Rec.Kind      and then
             Get_Physical_Line_Number (Sloc (N)) = Trace_Rec.Node_Line and then
             Get_Column_Number (Sloc (N))        = Trace_Rec.Node_Col;

   end Is_Equal;

end A4G.Asis_Tables;

Add the ASIS file $i

Add the ASIS file $i


-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

with ADO.Sessions;

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

   package Register is new AWA.Modules.Beans (Module => Wiki_Module,
                                              Module_Access => Wiki_Module_Access);

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wikis module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Save (DB);

      --  Add the permission for the user to use the new wiki space.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Wiki);
      Ctx.Commit;

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Ctx.Start;
      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

end AWA.Wikis.Modules;

-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Users.Models;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

with Ada.Calendar;
with ADO.Sessions;

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

   package Register is new AWA.Modules.Beans (Module => Wiki_Module,
                                              Module_Access => Wiki_Module_Access);

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wikis module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Save (DB);

      --  Add the permission for the user to use the new wiki space.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Wiki);
      Ctx.Commit;

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Ctx.Start;
      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Create a new wiki content for the wiki page.
   --  ------------------------------
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out Awa.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : AWA.Users.Models.User_Ref := Ctx.Get_User;
   begin
      --  Check that the user has the create wiki content permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Content.Set_Page (Page);
      Content.Set_Create_Date (Ada.Calendar.Clock);
      Content.Set_Author (User);
      Content.Save (DB);
      Page.Set_Content (Content);
      Page.Set_Last_Version (Page.Get_Last_Version + 1);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Content;

end AWA.Wikis.Modules;

Implement the Create_Wiki_Content procedure


------------------------------------------------------------------------------
--                                                                          --
--                   ASIS-for-GNAT INTERFACE COMPONENTS                     --
--                                                                          --
--      A S I S . C O M P I L A T I O N _ U N I T S . R E L A T I O N S     --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--           Copyright (c) 2006, Free Software Foundation, Inc.             --
--                                                                          --
-- This   specification  is  adapted   from  the  Ada   Semantic  Interface --
-- Specification Standard (ISO/IEC 15291) for use with GNAT.  In accordance --
-- with the copyright of that document, you can freely copy and modify this --
-- specification, provided that if you redistribute a modified version, any --
-- changes  that  you have made are clearly indicated. The copyright notice --
-- above,  and  the  license  provisions  that  follow  apply solely to the --
-- contents of the part following the private keyword.                      --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR  PURPOSE.  See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public  License  distributed with ASIS-for-GNAT;  see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--  12 package Asis.Compilation_Units.Relations
------------------------------------------------------------------------------
------------------------------------------------------------------------------
package Asis.Compilation_Units.Relations is
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  Asis.Compilation_Units.Relations encapsulates semantic relationship
--  concepts used in ASIS.
------------------------------------------------------------------------------
--  12.1  type Relationship
------------------------------------------------------------------------------
--  Relationship queries provide references to compilation units that are
--  related, in some specific fashion, to one or more given compilation units.
--  Compilation units located by these queries are returned as a set of
--  ordered lists.

   type Relationship
     (Consistent_Length   : Asis.ASIS_Natural;
      Inconsistent_Length : Asis.ASIS_Natural;
      Missing_Length      : Asis.ASIS_Natural;
      Circular_Length     : Asis.ASIS_Natural)
   is
      record
         Consistent   : Asis.Compilation_Unit_List (1 .. Consistent_Length);
         Inconsistent : Asis.Compilation_Unit_List (1 .. Inconsistent_Length);
         Missing      : Asis.Compilation_Unit_List (1 .. Missing_Length);
         Circular     : Asis.Compilation_Unit_List (1 .. Circular_Length);
      end record;

--  The following describes the semantics of the unit lists returned by the
--  queries Semantic_Dependence_Order and Elaboration_Order:
--
--  Each query returns a set of four lists.  Every unit returned will have the
--  same Enclosing_Context.  The lists are:
--
--    a) (Consistent)   A list of consistent ordered units.
--    b) (Inconsistent) A list of units that are inconsistent with one or
--                      more units on which they semantically depend.
--    c) (Missing)      A list of units that have missing (nonexistent) related
--                      units.
--    d) (Circular)     A list of circular semantic dependencies between units.
--
--
--  a) The consistent units list:
--
--     The semantics for the ordering of units in the first list are defined by
--     the individual queries.
--
--     Every unit in this list is unique.  No duplicates are returned; no
--     two units in the list are Is_Equal or Is_Identical.
--
--  b) The inconsistent units list:
--
--     The second list is made up of unit pairs.
--
--     Each pairing defines an inconsistent semantic dependence relationship.
--     The right unit of each pair semantically depends on the preceding left
--     unit. All rightmost units of each pair are always inconsistent, and will
--     not appear in the consistent units list. The leftmost unit can be either
--     consistent or inconsistent. If a leftmost units is consistent, then it
--     also appears in the consistent units list; otherwise the unit is part of
--     an inconsistent transitive relationship.
--
--     The unit pairs are ordered such that there are no forward semantic
--     dependencies between the inconsistent units.  Each inconsistent unit's
--     supporters always precede it in the list.
--
--     As an example, given four units, A withs B, B withs C, and C withs D;
--     if D is replaced, the inconsistent list contains six units with the
--     three pairs:
--
--        DC  CB  BA
--
--     The list indicates that units C, B, and A are inconsistent (the
--     rightmost units of each pair). Semantic dependencies such as B depends
--     on C also are indicated. The units C, B, and A are in an order that
--     could be submitted to the compiler (a possible recompilation order).
--
--     If a unit is inconsistent because the source for the unit has been
--     edited (or otherwise been made inconsistent by some action of the user
--     or implementation) then the unit references Nil_Compilation_Unit as the
--     cause of the inconsistency (e.g., (Nil A Nil B) is a list of two
--     inconsistent units, neither of which can point to a third unit as the
--     cause for their being inconsistent).
--
--  --|IP An implementation is allowed to use Nil_Compilation_Unit value for
--  --|IP the first unit of each pair if it cannot determine the supporting
--  --|IP unit causing the inconsistent semantic dependence.
--
--     For the above example, the list returned is:
--
--           DC DB DA CB CA BA
--
--     This list reports all dependencies:
--
--           D withed by C withed by B withed by A => DC DB DA
--                       C withed by B withed by A => CB CA
--                                   B withed by A => BA
--
--  c) The missing dependence list:
--
--     The third list is made up of unit pairs.   Each pairing consists of a
--     unit followed by a missing related unit needed by the first unit.
--     A missing unit is a required Compilation_Unit, with a known name, with a
--     Unit_Kind that is either A_Nonexistent_Declaration or
--     A_Nonexistent_Body.
--
--     For example:
--
--     Given a list containing the units:  AB AC
--
--     If Unit_Kind(B) = A_Nonexistent_Declaration and
--        Unit_Kind(C) = A_Nonexistent_Body then
--
--     It can be deduced that:
--        A is missing a needed supporter B (A depends semantically on B).
--        A is missing a needed related unit body C
--        (depending on the kind for A, C can be A's required body or some
--         subunit of A)
--
--     A unit is reported as missing only if the Post-Compilation Rules of Ada
--     determine it to be needed.  Reference Manual 10.2.
--
--  d) The circular dependence list:
--
--     Circular dependencies between compilation units are provided in the
--     fourth list.  There may be more than one set of circular dependencies.
--     The ordering of distinct sets in the list is implementation-defined.
--     This list will never contain nonexistent units.
--
--     The list is made up of unit pairs.  The second unit of each pair depends
--     semantically on the first unit.  A circularity is established when the
--     first unit of a pair also appears as the second unit of a later pair.
--     (See the unit A in the example below; it is the first unit of the first
--     pair and is the second unit of the third pair). The next set of circular
--     dependent units, if any, starts with the next unit in the list (the unit
--     D in the example below).
--
--     For example:
--
--     Given a list containing the units:  AC CB BA DG GF FE ED
--
--     It can be determined that there are two sets of circularly dependent
--     units:
--        {A, B, C} and {D, E, F, G}
--
--     The dependencies are:  A depends on B, B depends on C, C depends on A.
--            D depends on E, E depends on F, F depends on G, G depends on D.
--
--     Each circle of dependence is reported exactly once.  It is not reported
--     once for each unit in the circle.
--
------------------------------------------------------------------------------
--  12.2  constant Nil_Relationship
------------------------------------------------------------------------------

   Nil_Relationship : constant Relationship :=
           (Consistent_Length   => 0,
            Inconsistent_Length => 0,
            Missing_Length      => 0,
            Circular_Length     => 0,
            Consistent          => Asis.Nil_Compilation_Unit_List,
            Inconsistent        => Asis.Nil_Compilation_Unit_List,
            Missing             => Asis.Nil_Compilation_Unit_List,
            Circular            => Asis.Nil_Compilation_Unit_List);

------------------------------------------------------------------------------
--  12.3  function Semantic_Dependence_Order
------------------------------------------------------------------------------
--  Semantic Dependence Relationships    - Reference Manual 10.1.1(24).
--  Elaboration Dependence Relationships - Reference Manual 10.1.1(25).
--
--  --|AN Application Note:
--  --|AN
--  --|AN To properly determine unit consistency, use one of the two semantic
--  --|AN dependence queries: Elaboration_Order or Semantic_Dependence_Order.
--  --|AN These queries return a value of the type Relationship, which contains
--  --|AN lists of consistent, inconsistent, missing and circular units.
--  --|AN
--  --|AN For these two queries, the existence of units in one or more of the
--  --|AN inconsistent, missing, or circular units list means that the
--  --|AN consistent unit list may not be complete.
--  --|AN
--  --|AN Applications that do not check for inconsistent, missing, or circular
--  --|AN units before using the consistent list might not operate as expected.
--  --|AN
------------------------------------------------------------------------------

   function Semantic_Dependence_Order
               (Compilation_Units : Asis.Compilation_Unit_List;
                Dependent_Units   : Asis.Compilation_Unit_List;
                The_Context       : Asis.Context;
                Relation          : Asis.Relation_Kinds)
               return               Relationship;

------------------------------------------------------------------------------
--  Compilation_Units   - Specifies a list of pertinent units
--  Dependent_Units     - Specifies dependents used to limit the query
--  The_Context         - Specifies a program Context for context
--  Relation            - Specifies the relationship to query
--
--  Produces a Relationship value containing compilation_unit elements related
--  to the given Compilation_Units by the specified relation.
--
--  The compilation_unit elements in the consistent units list are ordered such
--  that there are no forward semantic dependencies.
--
--  Dependent_Units are ignored unless the Relation is Descendants or
--  Dependents.  The union of units in the needed units of the Dependent_Units
--  list provide a limiting context for the query.  Only members of these
--  needed units are present in the result.
--
--  If the Dependent_Units list is Is_Nil, the context for the search is the
--  entire Context.  The result of such a query is the full (unlimited)
--  list of Dependents for the Compilation_Units.
--
--  All units in the result will have an Enclosing_Context value that
--  Is_Identical to The_Context.
--

--  Appropriate Unit_Kinds:
--       A_Procedure
--       A_Function
--       A_Package
--       A_Generic_Procedure
--       A_Generic_Function
--       A_Generic_Package
--       A_Procedure_Instance
--       A_Function_Instance
--       A_Package_Instance
--       A_Procedure_Renaming
--       A_Function_Renaming
--       A_Package_Renaming
--       A_Generic_Procedure_Renaming
--       A_Generic_Function_Renaming
--       A_Generic_Package_Renaming
--       A_Procedure_Body
--       A_Function_Body
--       A_Package_Body
--       A_Procedure_Body_Subunit
--       A_Function_Body_Subunit
--       A_Package_Body_Subunit
--       A_Task_Body_Subunit
--       A_Protected_Body_Subunit
--       An_Unknown_Unit            -- See Implementation Permissions
--
--  The Semantic_Dependence_Order query should never raise an exception
--  when processing inconsistent unit (sub)sets.  This query is the only
--  means for an application to know if a given unit is consistent with
--  (some of) its supporters (dependents), and therefore the related
--  semantic processing can give valuable results for this unit.
--
--  --|IP Implementation Permissions:
--  --|IP
--  --|IP The handling of An_Unknown_Unit is implementation specific. It can be
--  --|IP possible to obtain Semantic Dependence Relationships when starting
--  --|IP with a list containing one or more units that are An_Unknown_Unit.
--  --|IP However, results may vary across ASIS implementations.
--  --|AN----------------------------------------------------------------------
--  --|AN Semantic_Dependence_Order defines consistent units to be ordered such
--  --|AN that there are no forward semantic dependencies.
--
------------------------------------------------------------------------------
--  12.4  function Elaboration_Order
------------------------------------------------------------------------------

   function Elaboration_Order
               (Compilation_Units : Asis.Compilation_Unit_List;
                The_Context       : Asis.Context)
               return               Relationship;

------------------------------------------------------------------------------
--  Compilation_Units   - Specifies a list of units to elaborate
--  The_Context         - Specifies a program Context for context
--
--  Produces, in elaboration order, a Relationship value containing compilation
--  units required to elaborate the given compilation units.
--
--  The return value contains the set of ordered lists described above for the
--  queries on Semantic Dependence Relationships.  If the inconsistent,
--  missing, and circular lists are empty, the consistent list will contain
--  all units required to elaborate the arguments.
--  --|IP
--  --|IP The Relationship value may include any number of
--  --|IP implementation-specific runtime support packages.
--
--  The first unit in the Consistent units list will always be the
--  specification for package Standard.  The list will contain all units
--  required to elaborate the arguments.
--
--  Use the Context_Clause_Elements query to get pragma Elaborate elements
--  for a compilation unit.
--
--  Appropriate Unit_Kinds:
--       A_Procedure
--       A_Function
--       A_Package
--       A_Generic_Procedure
--       A_Generic_Function
--       A_Generic_Package
--       A_Procedure_Instance
--       A_Function_Instance
--       A_Package_Instance
--       A_Procedure_Renaming
--       A_Function_Renaming
--       A_Package_Renaming
--       A_Generic_Procedure_Renaming
--       A_Generic_Function_Renaming
--       A_Generic_Package_Renaming
--       A_Procedure_Body
--       A_Function_Body
--       A_Package_Body
--       A_Procedure_Body_Subunit
--       A_Function_Body_Subunit
--       A_Package_Body_Subunit
--       A_Task_Body_Subunit
--       A_Protected_Body_Subunit
--       An_Unknown_Unit            -- See Implementation Permissions
--
--  --|IP Implementation Permissions:
--  --|IP
--  --|IP The handling of An_Unknown_Unit is implementation specific.  It can
--  --|IP be possible to obtain Semantic Dependence Relationships when starting
--  --|IP with a list containing one or more units that are An_Unknown_Unit.
--  --|IP However, results may vary across ASIS implementations.
--
------------------------------------------------------------------------------
end Asis.Compilation_Units.Relations;

Add the ASIS file $i

Add the ASIS file $i


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2022 onox <denkpadje@gmail.com>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with Orka.Numerics.Tensors.SIMD_CPU;

with Orka.SIMD.AVX.Doubles.Arithmetic;
with Orka.SIMD.AVX.Doubles.Compare;
with Orka.SIMD.AVX.Doubles.Logical;
with Orka.SIMD.AVX.Doubles.Math;
with Orka.SIMD.AVX.Longs.Logical;
with Orka.SIMD.AVX.Longs.Random.Emulation;
with Orka.SIMD.AVX.Longs.Arithmetic.Emulation;
with Orka.SIMD.AVX.Longs.Logical.Emulation;
with Orka.SIMD.AVX.Longs.Shift.Emulation;

package Orka.Numerics.Doubles.Tensors.CPU is new Orka.Numerics.Doubles.Tensors.SIMD_CPU
  (Index_4D,
   Integer_64,
   SIMD.AVX.Longs.m256l,
   SIMD.AVX.Longs.Arithmetic.Emulation."+",
   SIMD.AVX.Longs.Logical.Emulation."and",
   SIMD.AVX.Longs.Shift.Emulation.Shift_Elements_Left_Zeros,
   SIMD.AVX.Longs.Shift.Emulation.Shift_Elements_Right_Zeros,
   SIMD.AVX.Longs.Logical.Test_All_Ones,
   SIMD.AVX.Longs.Logical.Test_All_Zero,
   SIMD.AVX.Doubles.m256d,
   SIMD.AVX.Doubles.Arithmetic."*",
   SIMD.AVX.Doubles.Arithmetic."/",
   SIMD.AVX.Doubles.Arithmetic."+",
   SIMD.AVX.Doubles.Arithmetic."-",
   SIMD.AVX.Doubles.Arithmetic."-",
   SIMD.AVX.Doubles.Arithmetic."abs",
   SIMD.AVX.Doubles.Arithmetic.Sum,
   SIMD.AVX.Doubles.Arithmetic.Divide_Or_Zero,
   SIMD.AVX.Doubles.Math.Sqrt,
   SIMD.AVX.Doubles.Math.Min,
   SIMD.AVX.Doubles.Math.Max,
   SIMD.AVX.Doubles.Math.Ceil,
   SIMD.AVX.Doubles.Math.Floor,
   SIMD.AVX.Doubles.Math.Round_Nearest_Integer,
   SIMD.AVX.Doubles.Math.Round_Truncate,
   SIMD.AVX.Doubles.Logical.And_Not,
   SIMD.AVX.Doubles.Logical."and",
   SIMD.AVX.Doubles.Logical."or",
   SIMD.AVX.Doubles.Logical."xor",
   SIMD.AVX.Doubles.Compare."=",
   SIMD.AVX.Doubles.Compare."/=",
   SIMD.AVX.Doubles.Compare.">",
   SIMD.AVX.Doubles.Compare."<",
   SIMD.AVX.Doubles.Compare.">=",
   SIMD.AVX.Doubles.Compare."<=",
   SIMD.AVX.Longs.Random.Emulation.State,
   SIMD.AVX.Longs.Random.Emulation.Next,
   SIMD.AVX.Longs.Random.Emulation.Reset);
pragma Preelaborate (Orka.Numerics.Doubles.Tensors.CPU);

numerics: Add instantiation of SIMD_CPU for Float_64 using AVX

Some functions operate on vectors of Integer_64 and would normally
require AVX2 intrinsics. These are emulated with functions that use AVX
and SSE2 intrinsics.

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


------------------------------------------------------------------------------
--                                                                          --
--                   ASIS-for-GNAT INTERFACE COMPONENTS                     --
--                                                                          --
--                          A S I S . I T E R A T O R                       --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--           Copyright (c) 2006, Free Software Foundation, Inc.             --
--                                                                          --
-- This   specification  is  adapted   from  the  Ada   Semantic  Interface --
-- Specification Standard (ISO/IEC 15291) for use with GNAT.  In accordance --
-- with the copyright of that document, you can freely copy and modify this --
-- specification, provided that if you redistribute a modified version, any --
-- changes  that  you have made are clearly indicated. The copyright notice --
-- above,  and  the  license  provisions  that  follow  apply solely to the --
-- contents of the part following the private keyword.                      --
--                                                                          --
-- ASIS-for-GNAT is free software; you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY or  FITNESS FOR A PARTICULAR  PURPOSE.  See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General  Public  License  distributed with ASIS-for-GNAT;  see file --
-- COPYING.  If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  AdaCore                   --
-- (http://www.adacore.com).                                                --
--                                                                          --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
--  14 package Asis.Iterator
------------------------------------------------------------------------------
------------------------------------------------------------------------------
package Asis.Iterator is
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  Asis.Iterator encapsulates the generic procedure Traverse_Element which
--  allows an ASIS application to perform an iterative traversal of a
--  logical syntax tree. It requires the use of two generic procedures,
--  Pre_Operation, which identifies processing for the traversal, and
--  Post_Operation, which identifies processing after the traversal.
--  The State_Information allows processing state to be passed during the
--  iteration of Traverse_Element.
--
--  Package Asis.Iterator is established as a child package to highlight the
--  iteration capability and to facilitate the translation of ASIS to IDL.
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  14.1  procedure Traverse_Element
------------------------------------------------------------------------------

   generic

      type State_Information is limited private;

      with procedure Pre_Operation
                       (Element :        Asis.Element;
                        Control : in out Traverse_Control;
                        State   : in out State_Information) is <>;

      with procedure Post_Operation
                       (Element :        Asis.Element;
                        Control : in out Traverse_Control;
                        State   : in out State_Information) is <>;

   procedure Traverse_Element
     (Element :        Asis.Element;
      Control : in out Traverse_Control;
      State   : in out State_Information);

------------------------------------------------------------------------------
--  Element             - Specifies the initial element in the traversal
--  Control             - Specifies what next to do with the traversal
--  State_Information   - Specifies other information for the traversal
--
--  Traverses the element and all its component elements, if any.
--  Component elements are all elements that can be obtained by a combination
--  of the ASIS structural queries appropriate for the given element.
--
--  If an element has one or more component elements, each is called a child
--  element.  An element's parent element is its Enclosing_Element.  Children
--  with the same parent are sibling elements.  The type Traverse_Control uses
--  the terms children and siblings to control the traverse.
--
--  For each element, the formal procedure Pre_Operation is called when first
--  visiting the element.  Each of that element's children are then visited
--  and finally the formal procedure Post_Operation is called for the element.
--
--  The order of Element traversal is in terms of the textual representation of
--  the Elements.  Elements are traversed in left-to-right and top-to-bottom
--  order.
--
--  Traversal of Implicit Elements:
--
--  Implicit elements are not traversed by default.  However, they may be
--  explicitly queried and then passed to the traversal instance.  Implicit
--  elements include implicit predefined operator declarations, implicit
--  inherited subprogram declarations, implicit expanded generic specifications
--  and bodies, default expressions supplied to procedure, function, and entry
--  calls, etc.
--
--  Applications that wish to traverse these implicit Elements shall query for
--  them at the appropriate places in a traversal and then recursively call
--  their instantiation of the traversal generic.  (Implicit elements provided
--  by ASIS do not cover all possible Ada implicit constructs.  For example,
--  implicit initializations for variables of an access type are not provided
--  by ASIS.)
--
--  Traversal of Association lists:
--
--  Argument and association lists for procedure calls, function calls, entry
--  calls, generic instantiations, and aggregates are traversed in their
--  unnormalized forms, as if the Normalized parameter was False for those
--  queries.  Implementations that always normalize certain associations may
--  return Is_Normalized associations.  See the Implementation Permissions
--  for the queries Discriminant_Associations, Generic_Actual_Part,
--  Call_Statement_Parameters, Record_Component_Associations, or
--  Function_Call_Parameters.
--
--  Applications that wish to explicitly traverse normalized associations can
--  do so by querying the appropriate locations in order to obtain the
--  normalized list.  The list can then be traversed by recursively calling
--  the traverse instance.  Once that sub-traversal is finished, the Control
--  parameter can be set to Abandon_Children to skip processing of the
--  unnormalized argument list.
--
--  Traversal can be controlled with the Control parameter.
--
--  A call to an instance of Traverse_Element will not result in calls to
--  Pre_Operation or Post_Operation unless Control is set to Continue.
--
--  The subprograms matching Pre_Operation and Post_Operation can set
--  their Control parameter to affect the traverse:
--
--     Continue                -- Continues the normal depth-first traversal.
--
--     Abandon_Children        -- Prevents traversal of the current element's
--                             -- children.
--                             -- If set in a Pre_Operation, traversal picks up
--                             -- with the next sibling element of the current
--                             -- element.
--                             -- If set in a Post_Operation, this is the
--                             -- same as Continue, all children will already
--                             -- have been traversed.  Traversal picks up with
--                             -- the Post_Operation of the parent.
--
--     Abandon_Siblings        -- Prevents traversal of the current element's
--                             -- children and remaining siblings.
--                             -- If set in a Pre_Operation, this abandons the
--                             -- associated Post_Operation for the current
--                             -- element.  Traversal picks up with the
--                             -- Post_Operation of the parent.
--                             -- If set in a Post_Operation, traversal picks
--                             -- up with the Post_Operation of the parent.
--
--     Terminate_Immediately   -- Does exactly that.
--
--  Raises ASIS_Inappropriate_Element if the element is a Nil_Element
------------------------------------------------------------------------------

end Asis.Iterator;

Add the ASIS file $i

Add the ASIS file $i