----------------------------------------------------------------------
--  Translator.Processing - 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   -- ASIS components
  Asis.Declarations,
  Asis.Elements,
  Asis.Exceptions,
  Asis.Expressions;

with   -- Application specific units
  Dictionary,
  Producer,
  Thick_Queries,
  Utilities;

package body Translator.Processing is
   use Asis, Asis.Declarations, Asis.Elements, Asis.Exceptions, Asis.Expressions;
   use Dictionary, Producer, Utilities;

   -----------------------------
   -- Process_Infix_Operation --
   -----------------------------

   procedure Process_Infix_Operation (Left      : in     Asis.Element;
                                      Operation : in     Asis.Element;
                                      Right     : in     Asis.Element;
                                      Control   : in out Asis.Traverse_Control;
                                      State     : in out Info) is
      function Operation_Substitution  return Wide_String is
         -- Return the substitution of Operation is any,
         -- "" otherwise.
         The_Name :  Asis.Element;
      begin
         if Is_Nil (Operation)then
            return "";
         else
            The_Name := Corresponding_Name_Definition (Operation);
            -- Be careful, ASIS doc says:
            -- Corresponding_Name_Definition returns a Nil_Element if the reference
            -- is to an implicitly declared element for which the implementation does
            -- not provide declarations and defining name elements.
            if Is_Nil (The_Name) then
               return "";
            elsif Has_Substitution (The_Name) then
               return Substitution (The_Name,
                                    Kind => Short,
                                    Multiplicity => State.Allowed_Multiplicity);
            else
               return "";
            end if;
         end if;
      end Operation_Substitution;

      The_Substitution : constant Wide_String := Operation_Substitution;
   begin
      if The_Substitution /= "" and then The_Substitution (The_Substitution'First) /= '"' then
         -- An operator is being substituted to a regular function call
         -- => change the infixed call to a prefixed call
         if Is_Nil (Left) then
            Print_Up_To (Right, Included => False);
         else
            Print_Up_To (Left, Included => False);
         end if;

         Print (The_Substitution);
         Print (" (");
         if not Is_Nil (Left) then
            Traverse (Left, Control, State);
            if Control /= Continue then
               return;
            end if;
            Print (", ");
         end if;

         Advance (Operation);
         Traverse (Right, Control, State);
         Print (")");

      else
         -- Operator substituted with operator, or not substituted

         -- Traverse Left parameter (Is_Nil for unary operations)
         if not Is_Nil (Left) then
            Traverse (Left, Control, State);
            if Control /= Continue then
               return;
            end if;
         end if;

         -- Print function name (if required)
         if The_Substitution /= "" then
            Print_Up_To (Operation, Included => False);
            -- We must get rid of '"' that surrounds the name
            -- Also add spaces if an alphabetic operator
            if The_Substitution (The_Substitution'First + 1) in 'a'..'z' or
               The_Substitution (The_Substitution'First + 1) in 'A'..'Z'
            then
               Print (" ");
               Print (The_Substitution (The_Substitution'First+1 .. The_Substitution'Last-1));
               Print (" ");
            else
               Print (The_Substitution (The_Substitution'First+1 .. The_Substitution'Last-1));
            end if;
            Advance (Operation);
         end if;

         -- Traverse Right parameter
         Traverse (Right, Control, State);
      end if;

      if Control /= Terminate_Immediately then
         Control := Abandon_Children;
      end if;
   end Process_Infix_Operation;


   ------------------
   -- Process_Name --
   ------------------

   procedure Process_Name (Element   : in     Asis.Element;
                           Control   : in out Asis.Traverse_Control;
                           State     : in out Info) is
      The_Name      : Asis.Element;
      Substitutable : Boolean := False;
      Kind          : Substitution_Kind;
      use Thick_Queries;

      Long_Name : constant Boolean := Expression_Kind (Element) = A_Selected_Component;
   begin
      if Long_Name then
         The_Name := Corresponding_Name_Definition (Selector (Element));
      else
         The_Name := Corresponding_Name_Definition (Element);
         -- This assignment may raise ASIS_Inappropriate_Element; caught below.
      end if;

      -- Be careful, ASIS doc says:
      -- Corresponding_Name_Definition returns a Nil_Element if the reference
      -- is to an implicitly declared element for which the implementation does
      -- not provide declarations and defining name elements.
      if not Is_Nil (The_Name) then

         -- The order of the following if... elsif... statement determines the preference
         -- order for substitutions.

         if Long_Name and then Includes_Renaming (Prefix (Element)) then
            -- If any part of the prefix is a renaming, we assume that the right thing
            -- was done at the level of the renaming, so we don't do the substitution here.
            return;

         -- For selected components, try long substitution first
         -- But don't do it for record (or protected) components, since the selector
         -- is not a path (it is the enclosing variable).
         elsif Long_Name and then
           Declaration_Kind (Enclosing_Element(The_Name)) /= A_Component_Declaration and then
           Has_Substitution (The_Name, Kind => Qualified)
         then
            Substitutable := True;
            Kind          := Qualified;

         -- Take explicit substitution if provided
         elsif Has_Substitution (The_Name) then
            Substitutable := True;
            Kind          := Short;

         -- If the name is from a generic instance, and has been
         -- substituted in the generic, we must apply the same substitution.
         elsif Is_Part_Of_Instance (The_Name) and then
           Has_Substitution (Corresponding_Generic_Element (The_Name))
         then
            Substitutable := True;
            The_Name      := Corresponding_Generic_Element (The_Name);
            -- What kind of substitution if we have a long name and a long substitution?
            -- Since the prefix refers to the instance, not the generic, it seems safer
            -- to always make a short substitution. If something else is wanted, it seems
            -- that the user will need manual editing anyways, and the produced file will
            -- not compile. Let's see if users complain...
            Kind          := Short;

         -- If the name is from an implicit derivation, and the inherited
         -- operation has been substituted, we must apply the same substitution.
         elsif Is_Part_Of_Inherited (The_Name) then
            -- We must find the corresponding Name, but Asis provides only the
            -- Corresponding_Declaration for a derived *declaration*.
            -- Therefore, go up to the declaration, take corresponding element, then
            -- down to the name.
            declare
               Corresponding_Name : constant Asis.Element
                 := Names (Corresponding_Declaration (Enclosing_Element (The_Name)))(1);
            begin
               if Has_Substitution (Corresponding_Name) then
                  Substitutable := True;
                  The_Name      := Corresponding_Name;
               end if;
               -- For the substitution kind, we can apply the same reasoning as above
               -- for the generic case, since the prefix of a long name refers to the
               -- place of the derived type, not the place of the original type.
               Kind := Short;
            end;
         end if;

         if Substitutable then
            if Long_Name and Kind = Short then
               -- We only have a short substitution for a long name
               -- We must therefore recurse into the prefix
               if State.Allowed_Multiplicity = Multiple then
                  State := (Allowed_Multiplicity => Single,
                            Selected_Name_Depth  => 1);
               elsif State.Selected_Name_Depth > 0 then
                  State.Selected_Name_Depth := State.Selected_Name_Depth + 1;
               end if;
               Traverse (Prefix (Element), Control, State);
               if Control = Terminate_Immediately then
                  return;
               end if;
               Print_Up_To (Selector (Element),
                            Included => False);
            else
               Print_Up_To (Element,
                            Included => False);
            end if;

            Print (Substitution (The_Name,
                                 Kind => Kind,
                                 Multiplicity => State.Allowed_Multiplicity));
            Advance (Element);
            Control := Abandon_Children;
         end if;
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         -- A name of a pragma association for example
         -- We REALLY don't care
         null;
   end Process_Name;


  ---------------------------
   -- Process_Named_Element --
   ---------------------------

   procedure Process_Named_Element (The_Element : Element;
                                    The_Name    : Defining_Name) is
      -- Handle named elements whose name is repeated at the end, if the name is
      -- subject to substitution.
      -- All elements inside the current one have been printed by the post-procedure
      -- The only not yet printed elements in the declaration are:
      --   the keyword "end" (and maybe the preceding "is" in the case of an empty specification)
      --   the name
      --   the final ";"
      --   plus blank lines and comments.
      -- It is therefore safe to call Print_Up_To with a text substitution

      function Recursive_Substitution (The_Element : Asis.Element) return Wide_String is
         -- Recurses manually through the elements of the Defining_Expanded_Name
         -- This is kind of a simplified version of the pre-procedure
         use Asis.Declarations, Asis.Expressions;

         The_Name : Asis.Element;
      begin
         case Element_Kind (The_Element) is
            when A_Defining_Name =>
               case Defining_Name_Kind (The_Element) is
                  when A_Defining_Expanded_Name =>
                     if Has_Substitution (The_Element, Kind => Qualified) then
                        return Substitution (The_Element, Kind => Qualified);
                     else
                        return
                          Recursive_Substitution (Defining_Prefix   (The_Element)) & '.' &
                          Recursive_Substitution (Defining_Selector (The_Element));
                     end if;
                  when others =>
                     if Has_Substitution (The_Element) then
                        return Substitution (The_Element, Kind => Short);
                     else
                        return Defining_Name_Image (The_Element);
                     end if;
               end case;

            when An_Expression =>
               case Expression_Kind (The_Element) is
                  when A_Selected_Component =>
                     The_Name := Corresponding_Name_Definition (Selector (The_Element));
                     if Has_Substitution (The_Name, Kind => Qualified) then
                        return Substitution (The_Name, Kind => Qualified);
                     else
                        return
                          Recursive_Substitution (Prefix   (The_Element)) & '.' &
                          Recursive_Substitution (Selector (The_Element));
                     end if;

                  when An_Identifier =>
                     The_Name := Corresponding_Name_Definition (The_Element);
                     if Defining_Name_Kind (The_Name) = A_Defining_Expanded_Name then
                        The_Name := Defining_Selector (The_Name);
                     end if;
                     if Has_Substitution (The_Name) then
                        return Substitution (The_Name, Kind => Short);
                     else
                        return Defining_Name_Image (The_Name);
                     end if;

                  when others =>
                     -- Impossible
                     Failure ("Recursive substitution, other Expression_Kind");
               end case;

            when others =>
               -- Impossible
               Failure ("Recursive substitution, other Element_Kind");
         end case;
      end Recursive_Substitution;

      use Asis.Declarations;
   begin   -- Process_Named_Element
      if Defining_Name_Kind (The_Name) =  A_Defining_Expanded_Name then
         Print_Up_To (The_Element,
                      Included => True,
                      Changing => Defining_Name_Image (The_Name),
                      Into     => Recursive_Substitution (The_Name));
      elsif Has_Substitution (The_Name) then
         Print_Up_To (The_Element,
                      Included => True,
                      Changing => Defining_Name_Image (The_Name),
                      Into     => Substitution (The_Name, Kind => Short));
      end if;
   end Process_Named_Element;

end Translator.Processing;

