----------------------------------------------------------------------
--  Unrepresenter - Package body                                    --
--  Copyright (C) 2002 Adalog                                       --
--  Author: J-P. Rosen                                              --
--                                                                  --
--  ADALOG   is   providing   training,   consultancy,   expertise, --
--  assistance and custom developments  in Ada and related software --
--  engineering techniques.  For more info about our services:      --
--  ADALOG                   Tel: +33 1 41 24 31 40                 --
--  19-21 rue du 8 mai 1945  Fax: +33 1 41 24 07 36                 --
--  94110 ARCUEIL            E-m: info@adalog.fr                    --
--  FRANCE                   URL: http://www.adalog.fr              --
--                                                                  --
--  This  unit 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.  This  unit 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 this program; see file --
--  COPYING.   If not, write  to the  Free Software  Foundation, 59 --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.           --
--                                                                  --
--  As  a special  exception, if  other files  instantiate generics --
--  from  this unit,  or you  link this  unit with  other  files to --
--  produce an executable,  this unit does not by  itself cause the --
--  resulting executable  to be covered  by the GNU  General Public --
--  License.  This exception does  not however invalidate any other --
--  reasons why  the executable  file might be  covered by  the GNU --
--  Public License.                                                 --
----------------------------------------------------------------------

with   -- Standard Ada units
  Ada.Characters.Handling,
  Ada.Wide_Text_IO;

with   -- ASIS components
  Asis.Compilation_Units,
  Asis.Elements,
  Asis.Iterator;
pragma Elaborate_All (Asis.Iterator);

with   -- Application specific units
  Producer,
  Utilities;
package body Unrepresenter is
   use Asis;
   use Compilation_Units, Elements;
   use Utilities;
   ----------------------------------------------------------------
   --                 Internal elements                          --
   ----------------------------------------------------------------

   ------------------
   -- Global types --
   ------------------

   type Info is null record;

   --------------
   -- Traverse --
   --------------

   procedure Pre_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info);
   procedure Post_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info);
   procedure Traverse is new Asis.Iterator.Traverse_Element
     (Info, Pre_Procedure, Post_Procedure);

   --------------------
   -- Post_Procedure --
   --------------------

   procedure Post_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info) is
   begin
      null;
   end Post_Procedure;

   -------------------
   -- Pre_Procedure --
   -------------------

   procedure Pre_Procedure
     (Element : in     Asis.Element;
      Control : in out Asis.Traverse_Control;
      State   : in out Info) is
      use Producer;
   begin
      case Element_Kind (Element) is
         when A_Clause =>
            case Clause_Kind (Element) is
               when A_Representation_Clause =>
                  Print_Up_To (Element, Included => False);
                  Advance (Element);
               when others =>
                  null;
            end case;
         when A_Pragma =>
            case Pragma_Kind (Element) is
               when A_Pack_Pragma =>
                  Print_Up_To (Element, Included => False);
                  Advance (Element);
               when others =>
                  null;
            end case;
         when others =>
            null;
      end case;
   end Pre_Procedure;

   ----------------------------------------------------------------
   --                 Exported subprograms                       --
   ----------------------------------------------------------------

   -------------
   -- Process --
   -------------

   procedure Process (Unit_Name           : in     Wide_String;
                      Process_Spec        : in     Boolean;
                      Process_Body        : in     Boolean;
                      Print_Changed_Lines : in     Boolean;
                      Line_Length         : in     Natural;
                      Output_Prefix       : in     String;
                      Keep_Unchanged      : in     Boolean;
                      My_Context          : in out Asis.Context)
   is
      use Ada.Wide_Text_IO;
      F_Out : File_Type;

      procedure Do_Process (My_Unit : Compilation_Unit) is
         My_Declaration : Declaration;
         The_Control    : Traverse_Control := Continue;
         The_Info       : Info := (null record);
         Had_Changes    : Boolean;
         use Ada.Characters.Handling, Producer;
      begin
         if Is_Nil (My_Unit) then
            Trace (Wide_String'("Nil unit"));
            return;
         end if;

         if Output_Prefix /= "" then
            Safe_Open  (F_Out,
                        Name => Output_Prefix & To_String (Text_Name (My_Unit)),
                        Mode => Create);
            Set_Output (F_Out);
         end if;

      Process_Unit :
         begin
            My_Declaration := Unit_Declaration (My_Unit);
            Traverse (My_Declaration, The_Control, The_Info);
            if The_Control /= Terminate_Immediately then
               Print_Up_To (My_Declaration, Included => True, Final => True);
            end if;
         end Process_Unit;

         Producer.Finish (Had_Changes);

         if Is_Open (F_Out) then
            Set_Output (Standard_Output);
            if Had_Changes or Keep_Unchanged then
               Close (F_Out);
            else
               Delete (F_Out);
            end if;
         end if;

      exception
         when Overwrite_Error =>
            null;
         when others =>
            if Is_Open (F_Out) then
               Set_Output (Standard_Output);
               Close (F_Out);
            end if;
            raise;
      end Do_Process;

   begin  -- Process
      Producer.Initialize (Line_Length, Print_Changed_Lines);

      if Process_Spec then
         User_Message ("Unrepresenting " & Unit_Name & " specification");
         Do_Process (Library_Unit_Declaration (Unit_Name, My_Context));
      end if;
      if Process_Body then
         User_Message ("Unrepresenting " & Unit_Name & " body");
         Do_Process (Compilation_Unit_Body (Unit_Name, My_Context));
      end if;

   exception
      when others =>
         if Is_Open (F_Out) then
            Set_Output (Standard_Output);
            Close (F_Out);
         end if;
         raise;
   end Process;

end Unrepresenter;
