------------------------------------------------------------------------------
--                                                                          --
--                     ASIS UTILITY LIBRARY COMPONENTS                      --
--                                                                          --
--      A S I S _ U L . S O U R C E _ T A B L E . P R O C E S S I N G       --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2004-2011, AdaCore                     --
--                                                                          --
-- Asis Utility Library (ASIS UL) 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 UL  is distributed in the hope that it --
-- will  be  useful,  but  WITHOUT  ANY  WARRANTY; without even the implied --
-- warranty of MERCHANTABILITY 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 GNAT; see file --
-- COPYING. If not,  write  to the  Free Software Foundation,  51 Franklin --
-- Street, Fifth Floor, Boston, MA 02110-1301, USA.                         --
--                                                                          --
-- ASIS UL is maintained by AdaCore (http://www.adacore.com).               --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2005;  --  To make the unit compilable with Ada 95 compiler

with Ada.Characters.Conversions; use Ada.Characters.Conversions;

with GNAT.OS_Lib;                use GNAT.OS_Lib;
with Asis;                       use Asis;
with Asis.Ada_Environments;
with Asis.Compilation_Units;     use Asis.Compilation_Units;
with Asis.Errors;
with Asis.Exceptions;
with Asis.Extensions;            use Asis.Extensions;
with Asis.Implementation;

with ASIS_UL.Common;             use ASIS_UL.Common;
with ASIS_UL.Debug;              use ASIS_UL.Debug;
with ASIS_UL.Options;            use ASIS_UL.Options;
with ASIS_UL.Output;             use ASIS_UL.Output;
with ASIS_UL.Utilities;          use ASIS_UL.Utilities;

package body ASIS_UL.Source_Table.Processing is

   ------------------------
   --  Local subprograms --
   ------------------------

   procedure Process_Sources_From_Table
     (Only_Bodies        : Boolean := False;
      Need_Semantic_Info : Boolean := True;
      Add_Needed_Sources : Boolean := False);
   --  Processes sources stores in the sources table trying to minimize
   --  compilations needed to create the tree files. If Only_Bodies is set ON,
   --  only files with .adb suffixes are compiled for the trees.
   --  Need_Semantic_Info parameter is used to control unit processing on the
   --  base of each tree being created as a part of the call to
   --  Process_Sources_From_Table, see the documentation for the Process_Source
   --  routine.
   --  Add_Needed_Sources is used to specify if the needed sources (spec for
   --  a body and subunits for stubs) should be processed even if they are not
   --  in the source table, see the documentation for the Process_Source
   --  routine.

   procedure ASIS_Processing (CU : Asis.Compilation_Unit; SF : SF_Id);
   --  This procedure incapsulates all the actions performed in the opened
   --  Context with the compilation unit CU corresponding to the source file
   --  SF (the caller is responsible for the fact that CU with this SF are
   --  represented by the tree making up the currently processed ASIS Context).
   --  The corresponding processing is entirely tool-specific, so each tool
   --  should provide its own subunit as the actual implementation of this
   --  routine.

   ---------------------
   -- ASIS_Processing --
   ----------------------

   --  This is entirely tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure ASIS_Processing (CU : Asis.Compilation_Unit;  SF : SF_Id) is
     separate;

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

   --  This is entirely tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure Initialize is separate;

   --------------------------------------
   -- All_Files_Successfully_Processed --
   --------------------------------------

   function All_Files_Successfully_Processed return Boolean is
   begin
      for SF in First_SF_Id .. Last_Argument_Source loop
         if Source_Status (SF) /= Processed then
            return False;
         end if;
      end loop;

      return True;
   end All_Files_Successfully_Processed;

   --------------------
   -- Process_Source --
   --------------------

   procedure Process_Source
     (SF                 : SF_Id;
      Need_Semantic_Info : Boolean := True;
      Add_Needed_Sources : Boolean := False;
      Keep_ALI_Files     : Boolean := False)
   is
      Success     : Boolean;
      Next_SF     : SF_Id;
      CU_Tmp      : Asis.Compilation_Unit;

      procedure Process_All_Subunits (CU : Asis.Compilation_Unit);
      --  Assuming that CU is of Compilation_Unit kind that may have subunits,
      --  recuresively process all the subunits that are the arguments of the
      --  tool

      procedure Process_All_Subunits (CU : Asis.Compilation_Unit) is
         Subunit_List : constant Asis.Compilation_Unit_List := Subunits (CU);
         Next_Subunit_SF : SF_Id;
      begin

         for J in Subunit_List'Range loop
            Next_Subunit_SF :=
              File_Find (Normalize_Pathname
                (To_String (Text_Name (Subunit_List (J))),
                 Resolve_Links  => False,
                 Case_Sensitive => True));

            if Add_Needed_Sources and then not Present (Next_Subunit_SF) then
               Add_Needed_Source
                 (Normalize_Pathname
                   (To_String (Text_Name (Subunit_List (J))),
                    Resolve_Links  => False,
                    Case_Sensitive => True));

               Total_Sources := Natural (Last_Source);
               Sources_Left  := Sources_Left + 1;
            end if;

            if Present (Next_Subunit_SF)
             and then
               Source_Status (Next_Subunit_SF) = Waiting
            then
               Output_Source (Next_Subunit_SF);
               ASIS_Processing (Subunit_List (J), Next_Subunit_SF);

               Process_All_Subunits (Subunit_List (J));
            end if;

         end loop;

      end Process_All_Subunits;

   begin

      Output_Source (SF);

      Create_Tree (SF, Success);

      if not Success then
         return;
      end if;

      Asis.Ada_Environments.Associate
       (The_Context => The_Context,
        Name        => "",
        Parameters  => "-C1 "
                      & To_Wide_String (Suffixless_Name (SF) & ".adt"));

      declare
         use type Asis.Errors.Error_Kinds;
      begin
         Asis.Ada_Environments.Open (The_Context);
         Success := True;

         if Debug_Flag_T then
            Print_Tree_Sources;
         end if;
      exception
         when Asis.Exceptions.ASIS_Failed =>
            --  The only known situation when we can not open a C1 context for
            --  newly created tree is recompilation of System (see D617-017)

            if Asis.Implementation.Status = Asis.Errors.Use_Error
              and then
               Asis.Implementation.Diagnosis = "Internal implementation error:"
               & " Asis.Ada_Environments.Open - System is recompiled"
            then
               Error ("can not process redefinition of System in " &
                       Source_Name (SF));

               Set_Source_Status (SF, Not_A_Legal_Source);
               Success := False;
            else
               raise;
            end if;

      end;

      if Success then

         The_CU := Main_Unit_In_Current_Tree (The_Context);

         if Unit_Origin (The_CU) /= An_Application_Unit
           and then
            not Process_RTL_Units
         then
            Error ("cannot process RTL unit " & Source_Name (SF) &
                   " Use '-a' option for processing RTL components");
            Set_Source_Status (SF, Processed);
         else
            --  The following (commented out) code for optimizing subunit
            --  processing needs revising. Eliminating non-necessary tree
            --  creations for subunits is probably a good idea, but we cannot
            --  call Process_Source recursively!

--            if Unit_Class (The_CU) = A_Separate_Body then
--               --  If we have a proper body as the argument source, no need
--               --  to process subunits one-by-one separately:

--               CU_Tmp := Corresponding_Subunit_Parent_Body (The_CU);

--               while Unit_Class (CU_Tmp) = A_Separate_Body loop
--                  CU_Tmp := Corresponding_Subunit_Parent_Body (CU_Tmp);
--               end loop;

--               Next_SF :=
--                 File_Find (Normalize_Pathname
--                   (To_String (Text_Name (CU_Tmp))),
--                    Resolve_Links  => False,
--                    Case_Sensitive => False));

--               if Present (Next_SF) and then
--                  Source_Status (Next_SF) = Waiting
--               then
--                  Process_Source (Next_SF, Need_Semantic_Info);

--                  return;
--               end if;

--            end if;

            ASIS_Processing (The_CU, SF);

            if Need_Semantic_Info then
               --  The problem here is expanded generics - we can process
               --  expanded body only for the main unit in the tree (and only
               --  in case if we process bodies first!). So, all we can do is
               --  to process spec for a body and all the subunits, if any.
               --
               --  !!! Current approach works with the standard GNAT naming
               --  !!! scheme!!!

               if Unit_Kind (The_CU) in A_Procedure_Body .. A_Package_Body
                 or else
                  Unit_Class (The_CU) = A_Separate_Body
               then

                  if Unit_Kind (The_CU) in
                       A_Procedure_Body .. A_Package_Body
                  then
                     --  Process spec, if exists and not processed yet:

                     CU_Tmp := Corresponding_Declaration (The_CU);

                     if not Is_Nil (CU_Tmp) then
                        Next_SF :=
                          File_Find (Normalize_Pathname
                            (To_String (Text_Name (CU_Tmp)),
                             Resolve_Links  => False,
                             Case_Sensitive => True));

                        if Add_Needed_Sources
                          and then
                           not Present (Next_SF)
                        then
                           Add_Needed_Source
                             (Normalize_Pathname
                                (To_String (Text_Name (CU_Tmp)),
                                 Resolve_Links  => False,
                                 Case_Sensitive => True));

                           Total_Sources := Natural (Last_Source);
                           Sources_Left  := Sources_Left + 1;
                        end if;

                        if Present (Next_SF) and then
                           Source_Status (Next_SF) = Waiting
                        then
                           Output_Source (Next_SF);
                           ASIS_Processing (CU_Tmp, Next_SF);
                        end if;

                     end if;

                  end if;

                  Process_All_Subunits (The_CU);
               end if;

            else

               declare
                  All_CUs : constant Asis.Compilation_Unit_List :=
                    Asis.Compilation_Units.Compilation_Units (The_Context);
               begin

                  for J in All_CUs'Range loop

                     if Process_RTL_Units
                       or else
                        Unit_Origin (All_CUs (J)) = An_Application_Unit
                     then

                        Next_SF :=
                          File_Find (Normalize_Pathname
                            (To_String (Text_Name (All_CUs (J))),
                             Resolve_Links  => False,
                             Case_Sensitive => True));

                        if Present (Next_SF) and then
                           Source_Status (Next_SF) = Waiting
                        then
                           The_CU := All_CUs (J);
                           Output_Source (Next_SF);
                           ASIS_Processing (All_CUs (J), Next_SF);
                        end if;

                     end if;

                  end loop;

               exception
                  when Ex : others =>
                     Error
                       ("unknown bug detected when processing " &
                         Source_Name (Next_SF));
                     Error_No_Tool_Name
                       ("Please submit bug report to report@gnat.com");
                     Report_Unhandled_Exception (Ex);
                     Source_Clean_Up (Next_SF);
                     raise Fatal_Error;

               end;

            end if;

         end if;

      end if;

      Source_Clean_Up (SF, Keep_ALI_Files);

   exception

      when Program_Error =>
         Error ("installation problem - check "&
                Tool_Name.all & " and GNAT versions");
         raise Fatal_Error;

      when Fatal_Error =>
         raise;

      when Ex : others =>
         Error ("unknown bug detected when processing " & Source_Name (SF));
         Error_No_Tool_Name ("Please submit bug report to report@gnat.com");
         Report_Unhandled_Exception (Ex);
         Source_Clean_Up (SF);
         raise Fatal_Error;

   end Process_Source;

   ---------------------
   -- Process_Sources --
   ---------------------

   procedure Process_Sources
     (Need_Semantic_Info : Boolean := True;
      Add_Needed_Sources : Boolean := False)
   is
   begin
      Asis.Implementation.Initialize ("-k -ws -asis05");

      Process_Sources_From_Table
        (Only_Bodies        => True,
         Need_Semantic_Info => Need_Semantic_Info,
         Add_Needed_Sources => Add_Needed_Sources);

      Process_Sources_From_Table
        (Need_Semantic_Info => Need_Semantic_Info,
         Add_Needed_Sources => Add_Needed_Sources);

      Asis.Implementation.Finalize;
   end Process_Sources;

   --------------------------------
   -- Process_Sources_From_Table --
   --------------------------------

   procedure Process_Sources_From_Table
     (Only_Bodies        : Boolean := False;
      Need_Semantic_Info : Boolean := True;
      Add_Needed_Sources : Boolean := False)
   is
      Next_SF : SF_Id;
   begin
      Reset_Source_Iterator;

      Next_SF := Next_Non_Processed_Source (Only_Bodies);

      while Present (Next_SF) loop
         Process_Source (Next_SF, Need_Semantic_Info, Add_Needed_Sources);
         Next_SF := Next_Non_Processed_Source (Only_Bodies);
      end loop;

   end Process_Sources_From_Table;

   --------------
   -- Finalize --
   --------------

   --  This is entirely tool-specific, so the ASIS Utility Library provides
   --  an empty place-holder here.

   procedure Finalize is separate;

end ASIS_UL.Source_Table.Processing;
