------------------------------------------------------------------------------
--                                                                          --
--                           GNATELIM COMPONENTS                            --
--                                                                          --
--             A S I S . E X T E N S I O N S . H O M O N Y M S              --
--                                                                          --
--                         P a c k a g e   B o d y                          --
--                                                                          --
--                                                                          --
--           Copyright (C) 2002-2003 Ada Core Technologies, Inc.            --
--                                                                          --
-- GNATELIM  is  free software;  you can  redistribute it and/or  modify it --
-- under the terms of the  GNU  General Public License  as published by the --
-- Free Software Foundation; either version 2 or (at your option) any later --
-- version. GNATELIM is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public Li- --
-- cense 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,  59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA.                                              --
--                                                                          --
-- The original version  of  Gnatelim  was developed by  Alain  Le  Guennec --
-- It is now maintained by Ada Core Technologies Inc  (http://www.gnat.com) --
--                                                                          --
------------------------------------------------------------------------------

with Atree;    use Atree;
with Einfo;    use Einfo;
with Sinfo;    use Sinfo;

package body Asis.Extensions.Homonyms is

   -----------------
   -- Has_Homonym --
   -----------------

   function Has_Homonym (E : Asis.Element) return Boolean is

      function Has_Homonym_Internal (Entity : Entity_Id) return Boolean;
      --  Returns true if a given Entity in GNAT tree corresponds to the
      --  subprogram that has a homonym in the same scope. Derived from
      --  exp_dbug.adb

      --------------------------
      -- Has_Homonym_Internal --
      --------------------------

      function Has_Homonym_Internal (Entity : Entity_Id) return Boolean is
         E  : Entity_Id := Entity;

      begin

         --  If this is a child unit, we want the child

         if Nkind (E) = N_Defining_Program_Unit_Name then
            E := Defining_Identifier (Entity);
         end if;

         --  If the entity is a subprogram instance that is not a compilation
         --  unit, go to the original Ada entity

         if Is_Generic_Instance (E)
           and then Is_Subprogram (E)
           and then not Is_Compilation_Unit (Scope (E))
         then
            E := Related_Instance (Scope (E));
         end if;

         return Has_Homonym (E);

      end Has_Homonym_Internal;

   begin

      return Has_Homonym_Internal (E.R_Node);

   end Has_Homonym;

   --------------------
   -- Homonym_Number --
   --------------------

   function Homonym_Number (E : Asis.Element) return Natural is

      function Homonym_Number_Internal (Entity : Entity_Id) return Natural;
      --  Returns the homonym number of a given entity or zero if the entity
      --  has no homonyms

      -----------------------------
      -- Homonym_Number_Internal --
      -----------------------------

      function Homonym_Number_Internal (Entity : Entity_Id) return Natural is
         E  : Entity_Id := Entity;

      begin

         --  If this is a child unit, we want the child

         if Nkind (E) = N_Defining_Program_Unit_Name then
            E := Defining_Identifier (Entity);
         end if;

         --  If the entity is a subprogram instance that is not a compilation
         --  unit, go to the original Ada entity

         if Is_Generic_Instance (E)
           and then Is_Subprogram (E)
           and then not Is_Compilation_Unit (Scope (E))
         then
            E := Related_Instance (Scope (E));
         end if;

         if Has_Homonym (E) then
            declare
               H  : Entity_Id := Homonym (E);
               Nr : Natural := 1;

            begin
               while Present (H) loop
                  if Scope (H) = Scope (E) then
                     Nr := Nr + 1;
                  end if;

                  H := Homonym (H);
               end loop;
               return Nr;
            end;
         else
            return 0;
         end if;
      end Homonym_Number_Internal;

   begin

      return Homonym_Number_Internal (E.R_Node);

   end Homonym_Number;

end Asis.Extensions.Homonyms;
