-------------------------------------------------------------------------------
--
--  This file is part of AdaBrowse.
--
-- <STRONG>Copyright (c) 2002 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    AdaBrowse 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. AdaBrowse is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Useful predicates on @Asis.Element@. All predicates return @False@ if
--   called with inappropriate element kinds.
--
--   Whereever the following descriptions specify "a declaration of", this
--   also allows "a defining name in a declaration of".
--
--   Wherever the following descriptions specify "a declaration of a type" or
--   " a type declaration", this also allows "a type definition" of such a
--   type.
--
--   Mentions of "type" include generic formal types, "variable" includes
--   generic formal "in out" objects, and so on.
--
--   If @Element@ is an @Expression@, the predicates on types are also
--   applicable, they refer to the type of the expression. If the @Expression@
--   is a name (identifier, operator, enumeration literal, or selected
--   component), they refer to the referenced defining name.</DL>
--
-- <!--
-- Revision History
--
--   05-JUN-2003   TW  Initial version.
--   08-JUL-2003   TW  Added 'Is_Package'; changed 'Unique_Name' to really
--                     return the fully qualified name.
--   18-JUL-2003   TW  Changed to use the new @Asis2@ library.
-- -->
-------------------------------------------------------------------------------

pragma License (GPL);

with Ada.Exceptions;

with Asis.Clauses;
with Asis.Elements;

with AD.Messages;

with Asis2.Declarations;
with Asis2.Naming;
with Asis2.Predicates;

package body AD.Predicates is

   ----------------------------------------------------------------------------
   --  Units

   function Is_Private
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Private (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Private;

   function Is_Separate
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Separate (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Separate;

   function Is_Unit
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Unit (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Unit;

   function Is_Child
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Child (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Child;

   ----------------------------------------------------------------------------
   --  Items

   function Is_Constant
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Constant (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Constant;

   function Is_Variable
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Variable (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Variable;

   function Is_Package
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Package (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Package;

   function Is_Type
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Type (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Type;

   function Is_Subtype
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Subtype (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Subtype;

   --  Returns @True@ if @Element@ is a subtype declaration.

   function Is_Procedure
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Procedure (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Procedure;

   function Is_Function
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Function (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Function;

   function Is_Subprogram
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Subprogram (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Subprogram;

   function Is_Entry
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Entry (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Entry;

   ----------------------------------------------------------------------------
   --  Types, Variables, and Constants. See RM 3.2

   function Is_Elementary
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Elementary (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Elementary;

   function Is_Scalar
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Scalar (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Scalar;

   function Is_Discrete
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Discrete (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Discrete;

   function Is_Enumeration
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Enumeration (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Enumeration;

   function Is_Integral
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Integral (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Integral;

   function Is_Signed
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Signed (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Signed;

   function Is_Modular
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Modular (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Modular;

   function Is_Real
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Real (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Real;

   function Is_Float
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Float (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Float;

   function Is_Fixed
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Fixed (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Fixed;

   function Is_Ordinary_Fixed
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Ordinary_Fixed (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Ordinary_Fixed;

   function Is_Decimal_Fixed
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Decimal_Fixed (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Decimal_Fixed;

   function Is_Numeric
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Numeric (Element);
   end Is_Numeric;

   function Is_Access
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Access (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Access;

   function Is_Access_To_Object
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Access_To_Object (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Access_To_Object;

   function Is_Access_To_Subprogram
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Access_To_Subprogram (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Access_To_Subprogram;

   function Is_Composite
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Composite (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Composite;

   function Is_Array
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Array (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Array;

   function Is_Record
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Record (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Record;

   function Is_Tagged
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Tagged (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Tagged;

   function Is_Task
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Task (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Task;

   function Is_Protected
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Protected (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Protected;

   function Is_Limited
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Limited (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Limited;

   function Is_Class_Wide
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Class_Wide (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Class_Wide;

   function Is_Controlled
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Controlled (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Controlled;

   function Is_Private_Type
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Private_Type (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Private_Type;

   function Is_Incomplete
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Incomplete (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Incomplete;

   function Is_Aliased
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Aliased (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Aliased;

   ----------------------------------------------------------------------------
   --  Generics, renamings, and other stuff.

   function Is_Exception
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Exception (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Exception;

   function Is_Renaming
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Renaming (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Renaming;

   function Is_Generic
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Generic (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Generic;

   function Is_Generic_Formal
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Generic_Formal (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Generic_Formal;

   function Is_Instance
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Instance (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Instance;

   function Is_Abstract
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Abstract (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Abstract;

   function Is_Pragma
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Pragma (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Pragma;

   function Is_Clause
     (Element : in Asis.Element)
     return Boolean
   is
   begin
      return Asis2.Predicates.Is_Clause (Element);
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return False;
   end Is_Clause;

   ----------------------------------------------------------------------------
   --  Non-boolean queries

   function Unique_Name
     (Element : Asis.Element)
     return Wide_String
   is
      use Asis;
      use Asis.Elements;
      use Asis2.Naming;
   begin
      case Element_Kind (Element) is
         when A_Defining_Name =>
            return Fully_Qualified_Name (Element);
         when A_Declaration =>
            return Fully_Qualified_Name (Get_Name (Element));
         when A_Pragma =>
            return Container_Name (Element) & "." & Simple_Name (Element);
         when A_Clause =>
            case Representation_Clause_Kind (Element) is
               when An_Attribute_Definition_Clause |
                    An_Enumeration_Representation_Clause |
                    A_Record_Representation_Clause =>
                  return Container_Name (Element) & "." &
                         Simple_Name (Element);
               when others =>
                  null;
            end case;
         when others =>
            null;
      end case;
      return "";
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return "";
   end Unique_Name;

   function Simple_Name
     (Element : in Asis.Element)
     return Wide_String
   is
      use Asis;
      use Asis.Elements;

      use Asis2.Declarations;
      use Asis2.Naming;
   begin
      case Element_Kind (Element) is
         when A_Defining_Name =>
            if Is_Unit (Enclosing_Declaration (Element)) then
               return Full_Unit_Name (Enclosing_Compilation_Unit (Element));
            else
               return Name_Definition_Image (Element);
            end if;
         when A_Declaration =>
            return Get_Single_Name (Element);
         when A_Clause =>
            case Representation_Clause_Kind (Element) is
               when An_Attribute_Definition_Clause |
                    An_Enumeration_Representation_Clause |
                    A_Record_Representation_Clause =>
                  return Name_Expression_Image
                           (Asis.Clauses.Representation_Clause_Name (Element));
               when others =>
                  null;
            end case;
         when A_Pragma =>
            return Pragma_Name_Image (Element);
         when others =>
            null;
      end case;
      return "";
   exception
      when E : others =>
         AD.Messages.Debug (Ada.Exceptions.Exception_Information (E));
         return "";
   end Simple_Name;

end AD.Predicates;
