------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                        A S I S . E L E M E N T S                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.34 $
--                                                                          --
--            Copyright (c) 1995-2002, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-GNAT 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-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; 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.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with System.Assertions;
with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Interfaces;              use Interfaces;

with Asis.Exceptions;         use Asis.Exceptions;
with Asis.Compilation_Units;
with Asis.Declarations;
with Asis.Definitions;
with Asis.Statements;
with Asis.Clauses;

with Asis.Set_Get;            use  Asis.Set_Get;

with A4G.Knd_Conv;            use A4G.Knd_Conv;
with A4G.Int_Knds;            use A4G.Int_Knds;
with A4G.Mapping;             use A4G.Mapping;
with A4G.Vcheck;              use A4G.Vcheck;
with A4G.Encl_El;             use A4G.Encl_El;
with A4G.A_Sinput;            use A4G.A_Sinput;
with A4G.A_Output;            use A4G.A_Output;
with A4G.Contt;               use A4G.Contt;
with A4G.Contt.UT;            use A4G.Contt.UT;
with A4G.Asis_Tables;         use A4G.Asis_Tables;

with Types;                   use Types;
with Sinfo;                   use Sinfo;
with Atree;                   use Atree;
with Stand;                   use Stand;
with Sinput;                  use Sinput;

package body Asis.Elements is
   --  !!!??? This file is '-gnatg-compilable', but both its content and its
   --  !!!???  documentation need revising

   function "=" (Left, Right : Element) return Boolean
      renames Asis.Set_Get."=";

------------------------------------------------------------------------------

   LT : String renames ASIS_Line_Terminator;

   function Unit_Declaration
     (Compilation_Unit : in Asis.Compilation_Unit)
      return Asis.Declaration
   is
      Unit_Kind             : Asis.Unit_Kinds;
      Unit_Declaration_Node : Node_Id;
      Special_Case          : Special_Cases := Not_A_Special_Case;
   begin
      Check_Validity (Compilation_Unit,
                      "Asis.Elements.Unit_Declaration");

      Reset_Context (Encl_Cont_Id (Compilation_Unit));
      Unit_Kind := Kind (Compilation_Unit);

      if Unit_Kind = Not_A_Unit then
         Raise_ASIS_Inappropriate_Compilation_Unit
           ("Asis.Elements.Unit_Declaration");
      end if;

      if   Unit_Kind = A_Nonexistent_Declaration or else
           Unit_Kind = A_Nonexistent_Body        or else
           Unit_Kind = An_Unknown_Unit
      then
         return Nil_Element;
      end if;

      if Is_Standard (Compilation_Unit) then
         Special_Case          := Explicit_From_Standard;
         Unit_Declaration_Node := Standard_Package_Node;

--      elsif Unit_Kind in A_Procedure_Instance .. A_Function_Instance then
--         Unit_Declaration_Node :=
--            Original_Node (Unit (Top (Compilation_Unit)));

      else
         Unit_Declaration_Node := Unit (Top (Compilation_Unit));
      end if;

      if  Unit_Kind = A_Procedure_Body_Subunit or else
          Unit_Kind = A_Function_Body_Subunit  or else
          Unit_Kind = A_Package_Body_Subunit   or else
          Unit_Kind = A_Task_Body_Subunit      or else
          Unit_Kind = A_Protected_Body_Subunit
      then
         --  one step down the tree is required.
         --  No Asis Element can correspond to
         --  the N_Subunit Node
         Unit_Declaration_Node := Proper_Body (Unit_Declaration_Node);
      end if;

      return Node_To_Element_New (Node      => Unit_Declaration_Node,
                                  Spec_Case => Special_Case,
                                  In_Unit   => Compilation_Unit);
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
            "Asis.Elements.Unit_Declaration");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
            "Asis.Elements.Unit_Declaration");
   end Unit_Declaration;
-----------------------------------------------------------------------------

   function Enclosing_Compilation_Unit (Element : in Asis.Element)
      return Asis.Compilation_Unit
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Element);
   begin

      Check_Validity (Element,
                      "Asis.Elements.Enclosing_Compilation_Unit");

      if Arg_Kind = Not_An_Element then
         Raise_ASIS_Inappropriate_Element
              ("Asis.Elements.Enclosing_Compilation_Unit");
      end if;

      return Encl_Unit (Element);

   end Enclosing_Compilation_Unit;
-----------------------------------------------------------------------------

   function Context_Clause_Elements
     (Compilation_Unit : in Asis.Compilation_Unit;
      Include_Pragmas  : in Boolean := False)
      return Asis.Context_Clause_List
   is
      Unit_Kind   : Asis.Unit_Kinds; -- Compilation_Unit kind
      List_Before : List_Id;
   begin
      Check_Validity (Compilation_Unit,
                      "Asis.Elements.Context_Clause_Elements");

      Unit_Kind := Kind (Compilation_Unit);

      if Unit_Kind = Not_A_Unit then
         Raise_ASIS_Inappropriate_Compilation_Unit
              ("Asis.Elements.Context_Clause_Elements");
      end if;

      if Is_Standard (Compilation_Unit)        or else
         Unit_Kind = A_Nonexistent_Declaration or else
         Unit_Kind = A_Nonexistent_Body        or else
         Unit_Kind = An_Unknown_Unit
      then
         return Nil_Element_List;
      end if;

      List_Before := Context_Items (Top (Compilation_Unit));

--      if Include_Pragmas then
--          return Node_To_Element_List (List    => List_Before,
--                                        In_Unit => Compilation_Unit);
--      else
--          return Node_To_Element_List (List           => List_Before,
--                                        In_Unit        => Compilation_Unit,
--                                        To_Be_Included => No_Pragma'Access);
--      end if;

      return N_To_E_List_New
    (List             => List_Before,
     Include_Pragmas  => Include_Pragmas,
     In_Unit          => Compilation_Unit);
   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
           "Asis.Elements.Context_Clause_Elements");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
            "Asis.Elements.Context_Clause_Elements");
   end Context_Clause_Elements;
------------------------------------------------------------------------------
--  NOT IMPLEMENTED

   function Configuration_Pragmas
     (The_Context : in Asis.Context)
      return Asis.Pragma_Element_List
   is
   begin
      Check_Validity (The_Context,
               "Asis.Elements.Configuration_Pragmas");

      return Nil_Element_List;

   exception

      when ASIS_Inappropriate_Context =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
               "Asis.Elements.Configuration_Pragmas");
         raise;
      when others      =>
         Raise_ASIS_Failed (
               "Asis.Elements.Configuration_Pragmas");

   end Configuration_Pragmas;
-----------------------------------------------------------------------------

   function Compilation_Pragmas (Compilation_Unit : in Asis.Compilation_Unit)
      return Asis.Pragma_Element_List
   is
      Unit_Kind   : Asis.Unit_Kinds;
      List_Before : List_Id;
      List_After  : List_Id;
   begin

      Check_Validity (Compilation_Unit,
                      "Asis.Elements.Compilation_Pragmas");

      Unit_Kind := Kind (Compilation_Unit);

      if Unit_Kind = Not_A_Unit then
         Raise_ASIS_Inappropriate_Compilation_Unit
              ("Asis.Elements.Compilation_Pragmas");
      end if;

      if Is_Standard (Compilation_Unit)        or else
         Unit_Kind = A_Nonexistent_Declaration or else
         Unit_Kind = A_Nonexistent_Body        or else
         Unit_Kind = An_Unknown_Unit
      then
         return Nil_Element_List;
      end if;

      List_Before := Context_Items (Top (Compilation_Unit));

      List_After  := Pragmas_After (Aux_Decls_Node (Top (Compilation_Unit)));

      return N_To_E_List_New
               (List            => List_Before,
                Include_Pragmas => True,
                In_Unit         => Compilation_Unit,
                Node_Knd        => N_Pragma)
         &
             N_To_E_List_New
               (List            => List_After,
                Include_Pragmas => True,
                In_Unit         => Compilation_Unit);

   exception
      when ASIS_Inappropriate_Compilation_Unit =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (Outer_Call =>
           "Asis.Elements.Compilation_Pragmas");
         raise;
      when others =>
         Raise_ASIS_Failed (Diagnosis =>
           "Asis.Elements.Compilation_Pragmas");
   end Compilation_Pragmas;
------------------------------------------------------------------------------

   function Element_Kind (Element : in Asis.Element)
                         return Asis.Element_Kinds is
   begin
      Check_Validity (Element, "Asis.Elements.Element_Kind");
      return Kind (Element);
   end Element_Kind;
-----------------------------------------------------------------------------

   function Pragma_Kind (Pragma_Element : Asis.Pragma_Element)
                        return Asis.Pragma_Kinds is
   begin
      Check_Validity (Pragma_Element, "Asis.Elements.Pragma_Kind");
      return Pragma_Kind_From_Internal (Int_Kind (Pragma_Element));
   end Pragma_Kind;
-----------------------------------------------------------------------------

   function Defining_Name_Kind (Defining_Name : in Asis.Defining_Name)
                          return Asis.Defining_Name_Kinds is
   begin
      Check_Validity (Defining_Name, "Asis.Elements.Defining_Name_Kind");
      return Defining_Name_Kind_From_Internal (Int_Kind (Defining_Name));
   end Defining_Name_Kind;
-----------------------------------------------------------------------------

   function Declaration_Kind (Declaration : in Asis.Declaration)
                 return Asis.Declaration_Kinds is
   begin
      Check_Validity (Declaration, "Asis.Elements.Declaration_Kind");
      return Declaration_Kind_From_Internal (Int_Kind (Declaration));
   end Declaration_Kind;
-----------------------------------------------------------------------------

   function Trait_Kind (Element : in Asis.Element)
            return Asis.Trait_Kinds is

   --  Trait-related flag values:

      Is_Abstract : Boolean;
      Is_Limited  : Boolean;
      Is_Aliased  : Boolean;
      Is_Private  : Boolean;

      Arg_Node            : Node_Id;
      Trait_Defining_Node : Node_Id;
      --  if the Node (Elemen) is not enough for defining the result,
      --  Trait_Defining_Node is used for the tree traversing

   begin

      Check_Validity (Element, "Asis.Elements.Trait_Kind");

--  ASIS_Element_Kinds.Trait_Kinds literals and GNAT tree flags mapping:
--
--  type Trait_Kinds is (
--
--    Not_A_Trait,     --> Unexpected element, its node always has no
--                     --  correcponding flags and its kind does not belong
--                     --  to the Node Kinds for which A_Private_Trait could
--                     --  be determined
--
--    An_Ordinary_Trait, -->  all flags are set off, and the node kind
--                            does not belong to the Node Kinds for which
--                            A_Private_Trait could be determined
--
--    An_Aliased_Trait,  -->  Aliased_Present set ON
--
--    An_Access_Definition_Trait, --> no special flag, could be defined
--                                --  on the base of the presence of
--                                --  the N_Access_Definition node as the
--                                --  child node of the argument node
--
--    A_Reverse_Trait,  --> Reverse_Present set ON
--
--    A_Private_Trait,  --> except the case of
--                          A_Formal_Derived_Type_Definition,
--                      --  no special flag is presented in the corresponding
--                      --  node, the A_Private_Trait could be defined
--                      --  on the base of Node Kinds and setting other
--                      --  flags OFF;
--                      --  for A_Formal_Derived_Type_Definition -
--                      --  Private_Present set ON
--
--    A_Limited_Trait,  --> Limited_Present set ON and corresponding node
--                      --  does not belong to the Node Kinds for which
--                      --  A_Private_Trait could be defined
--
--    A_Limited_Private_Trait, --> Limited_Present set ON and corresponding
--                             -- node belongs to the Node Kinds for which
--                             -- A_Private_Trait could be defined
--
--    An_Abstract_Trait, --> For types: Abstract_Present set ON and
--                       --  corresponding node does not belong to the
--                       --  Node Kinds for which A_Private_Trait could be
--                       --  defined;
--                       --  For subprograms: no special flag, could be
--                       --  defined on the base of the Node Kind of the
--                       --  argument node
--
--    An_Abstract_Private_Trait, --> except the case of
--                               --  A_Formal_Derived_Type_Definition,
--                               --  Abstract_Present set ON and corresponding
--                               --  node belongs to the Node Kinds for which
--                               --  A_Private_Trait could be defined;
--                               --  for A_Formal_Derived_Type_Definition -
--                               --  Abstract_Present set ON and
--                               --  Private_Present set ON
--
--    An_Abstract_Limited_Trait, --> Abstract_Present set ON,
--                               --  Limited_Present set ON
--                               --  and corresponding node does not belong
--                               --  to the Node Kinds for which
--                               --  A_Private_Trait could be defined
--
--    An_Abstract_Limited_Private_Trait); --> Abstract_Present set ON,
--                                        --  Limited_Present set ON and
--                                        --  corresponding node belongs
--                                        --  to Node Kinds for which
--                                        --  A_Private_Trait could be defined
--
----------------------------------------------------------------------------
--  Expected Argument_Kinds:     ->       Corresponding tree Nodes:
--   Possible Trait values:     -->         Provided trait-related flags and
--                                          combination of their values
--                                          corresponding to the Trait value
----------------------------------------------------------------------------
--
--  Expected Declaration_Kinds:
--  ==========================
--
--     A_Private_Type_Declaration      -> N_Private_Type_Declaration (*1*)
--      A_Private_Trait                   --> Abstract_Present = OFF
--                                            Limited_Present  = OFF
--
--      A_Limited_Private_Trait           --> Abstract_Present = OFF
--                                            Limited_Present  = ON
--
--      An_Abstract_Private_Trait         --> Abstract_Present = ON
--                                            Limited_Present  = OFF
--
--      An_Abstract_Limited_Private_Trait --> Abstract_Present = ON
--                                            Limited_Present  = ON
-----------------------------------------------
--     A_Private_Extension_Declaration -> N_Private_Extension_Declaration (*2*)
--      A_Private_Trait                   --> Abstract_Present = OFF
--
--      An_Abstract_Private_Trait         --> Abstract_Present = ON
-----------------------------------------------
--     A_Variable_Declaration          -> N_Object_Declaration      (*3*)
--      An_Ordinary_Trait                 --> Aliased_Present = OFF
--
--      An_Aliased_Trait                  --> Aliased_Present = ON
-----------------------------------------------
--     A_Constant_Declaration          -> N_Object_Declaration      (*3*)
--      An_Ordinary_Trait                 --> Aliased_Present = OFF
--
--      An_Aliased_Trait                  --> Aliased_Present = ON
-----------------------------------------------
--     A_Deferred_Constant_Declaration -> N_Object_Declaration      (*3*)
--      An_Ordinary_Trait                 --> Aliased_Present = OFF
--
--      An_Aliased_Trait                  --> Aliased_Present = ON
-----------------------------------------------
--     A_Discriminant_Specification    -> N_Discriminant_Specification  (*4*)
--                                            Has no trait-related flags
--
--      An_Ordinary_Trait --> Nkind(Discriminant_Type(Definition.Node))
--                                   /=  N_Access_Definition
--      An_Access_Definition_Trait--> Nkind(Discriminant_Type(Definition.Node))
--                                   =   N_Access_Definition
-----------------------------------------------
--     A_Loop_Parameter_Specification  -> N_Loop_Parameter_Specification (*5*)
--      An_Ordinary_Trait                 --> Reverse_Present = OFF
--
--      A_Reverse_Trait                   --> Reverse_Present = ON
-----------------------------------------------
--     A_Procedure_Declaration         -> N_Subprogram_Declaration (*6*)
--      An_Ordinary_Trait  --> No flag needed to deternine the trait
--                                     -> N_Abstract_Subprogram_Declaration
--      An_Abstract_Trait  --> No flag needed to deternine the trait
-----------------------------------------------
--     A_Function_Declaration          -> N_Subprogram_Declaration  (*6*)
--      An_Ordinary_Trait  --> No flag needed to deternine the trait
--                                     -> N_Abstract_Subprogram_Declaration
--      An_Abstract_Trait  --> No flag needed to deternine the trait
-----------------------------------------------
--     A_Parameter_Specification       -> N_Parameter_Specification  (*4*)
--                                            Has no trait-related flags
--
--      An_Ordinary_Trait --> Nkind(Parameter_Type(Definition.Node))
--                                   /=  N_Access_Definition
--      An_Access_Definition_Trait --> Nkind(Parameter_Type(Definition.Node))
--                                   =   N_Access_Definition
-----------------------------------------------
--
--  Expected Definition_Kinds:
--  =========================
--
--     A_Component_Definition          -> N_Subtype_Indication    (*10*)
--                                        N_Identifier
--                                        N_Expanded_Name
--      An_Ordinary_Trait --> Aliased_Present set OFF in the PARENT node
--      An_Aliased_Trait  --> Aliased_Present set  ON in the PARENT nod
--
--     A_Private_Type_Definition       -> N_Private_Type_Declaration  (*1*)
--      The situation is just the same as for A_Private_Type_Declaration
-----------------------------------------------
--     A_Tagged_Private_Type_Definition-> N_Private_Type_Declaration  (*1*)
--      The situation is just the same as for A_Private_Type_Declaration
-----------------------------------------------
--     A_Private_Extension_Definition  -> N_Private_Extension_Declaration (*2*)
--      The situation is just the same as for N_Private_Extension_Declaration
-----------------------------------------------
--
--  Expected Type_Kinds:
--  ===================
--
-----------------------------------------------
--     A_Derived_Type_Definition             -> N_Derived_Type_Definition (*7*)
--      An_Ordinary_Trait                       --> Abstract_Present = OFF
--
--      An_Abstract_Trait                       --> Abstract_Present = ON
-----------------------------------------------
--     A_Derived_Record_Extension_Definition -> N_Derived_Type_Definition (*7*)
--      An_Ordinary_Trait                       --> Abstract_Present = OFF
--
--      An_Abstract_Trait                       --> Abstract_Present = ON
-----------------------------------------------
--     A_Record_Type_Definition              -> N_Record_Definition      (*8*)
--      An_Ordinary_Trait                       --> Abstract_Present = OFF
--                                                  Limited_Present  = OFF
--
--      An_Abstract_Trait                       --> Abstract_Present = ON
--                                                  Limited_Present  = OFF
--
--      A_Limited_Trait                         --> Abstract_Present = OFF
--                                                  Limited_Present  = ON
--
--      An_Abstract_Limited_Trait               --> Abstract_Present = ON
--                                                  Limited_Present  = ON
-----------------------------------------------
--     A_Tagged_Record_Type_Definition       -> N_Record_Definition      (*8*)
--      An_Ordinary_Trait                       --> Abstract_Present = OFF
--                                                  Limited_Present  = OFF
--
--      An_Abstract_Trait                       --> Abstract_Present = ON
--                                                  Limited_Present  = OFF
--
--      A_Limited_Trait                         --> Abstract_Present = OFF
--                                                  Limited_Present  = ON
--
--      An_Abstract_Limited_Trait               --> Abstract_Present = ON
--                                                  Limited_Present  = ON
-----------------------------------------------
--
--  Expected Formal_Type_Kinds:
--  ==========================
--
--     A_Formal_Private_Type_Definition -> N_Formal_Private_Type_Definition
--        (*1*)
--      The situation is just the same as for A_Private_Type_Declaration
-----------------------------------------------
--     A_Formal_Tagged_Private_Type_Definition ->
--        N_Formal_Private_Type_Definition (*1*)

--
--      The situation is just the same as for A_Private_Type_Declaration
-----------------------------------------------
--    A_Formal_Derived_Type_Definition -> N_Formal_Derived_Type_Definition(*9*)
--     An_Ordinary_Trait                       --> Abstract_Present = OFF
--                                                 Private_Present  = OFF
--
--     An_Abstract_Trait                       --> Abstract_Present = ON
--                                                 Private_Present  = OFF
--
--     A_Private_Trait                         --> Abstract_Present = OFF
--                                                 Private_Present  = ON
--
--     An_Abstract_Private_Trait               --> Abstract_Present = ON
--                                                 Private_Present  = ON
------------------------------------------------------------------------------

      Arg_Node := Node (Element);

      case Int_Kind (Element) is

      --  expected argument:

      when -- (*1*)
            A_Private_Type_Declaration
          | A_Private_Type_Definition
          | A_Tagged_Private_Type_Definition
          | A_Formal_Private_Type_Definition
          | A_Formal_Tagged_Private_Type_Definition =>

            Is_Abstract := Abstract_Present (Arg_Node);
            Is_Limited  := Limited_Present  (Arg_Node);

            if Is_Abstract and Is_Limited then
               return An_Abstract_Limited_Private_Trait;
            elsif Is_Abstract then
               return An_Abstract_Private_Trait;
            elsif Is_Limited then
               return A_Limited_Private_Trait;
            else
               return A_Private_Trait;
            end if;

      when -- (*2*)
            A_Private_Extension_Declaration
          | A_Private_Extension_Definition =>

            Is_Abstract := Abstract_Present (Arg_Node);

            if Is_Abstract then
               return An_Abstract_Private_Trait;
            else
               return A_Private_Trait;
            end if;

      when -- (*3*)
            A_Variable_Declaration
          | A_Constant_Declaration
          | A_Deferred_Constant_Declaration  =>

            Is_Aliased := Aliased_Present (Arg_Node);

            if Is_Aliased then
               return An_Aliased_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*4*)
            A_Discriminant_Specification
          | A_Parameter_Specification =>

            if Int_Kind (Element) = A_Discriminant_Specification then
               Trait_Defining_Node := Discriminant_Type (Arg_Node);
            else
               Trait_Defining_Node := Parameter_Type (Arg_Node);
            end if;

            if Nkind (Trait_Defining_Node) = N_Access_Definition then
               return An_Access_Definition_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*5*)
            A_Loop_Parameter_Specification =>

            if Reverse_Present (Arg_Node) then
               return A_Reverse_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*6*)
            A_Procedure_Declaration
          | A_Function_Declaration =>

            if Nkind (Arg_Node) = N_Abstract_Subprogram_Declaration then
               return An_Abstract_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*7*)
            A_Derived_Type_Definition
          | A_Derived_Record_Extension_Definition =>

            if Abstract_Present (Arg_Node) then
               return An_Abstract_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*8*)
            A_Record_Type_Definition
          | A_Tagged_Record_Type_Definition =>

            Is_Abstract := Abstract_Present (Arg_Node);
            Is_Limited  := Limited_Present  (Arg_Node);

            if Is_Abstract and Is_Limited then
               return An_Abstract_Limited_Trait;
            elsif Is_Abstract then
               return An_Abstract_Trait;
            elsif Is_Limited then
               return A_Limited_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*9*)
            A_Formal_Derived_Type_Definition =>

            Is_Abstract := Abstract_Present (Arg_Node);
            Is_Private  := Private_Present  (Arg_Node);

            if Is_Abstract and Is_Private then
               return An_Abstract_Private_Trait;
            elsif Is_Abstract then
               return An_Abstract_Trait;
            elsif Is_Private then
               return A_Private_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      when -- (*10*)
            A_Component_Definition =>

            if Aliased_Present (Parent (R_Node (Element))) then
               return An_Aliased_Trait;
            else
               return An_Ordinary_Trait;
            end if;

      --  unexpected argument:

      when others =>
         return Not_A_Trait;
      end case;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Element,
            Outer_Call => "Asis.Elements.Trait_Kind");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Element,
            Diagnosis => "Asis.Elements.Trait_Kind");
   end Trait_Kind;
------------------------------------------------------------------------------

   function Declaration_Origin (Declaration : in Asis.Declaration)
                   return Asis.Declaration_Origins is
   begin
      --  The implementation may require revising when the semantic queries
      --  and implicit elements are implemented.
      Check_Validity (Declaration, "Asis.Elements.Declaration_Origin");

      if Int_Kind (Declaration) not in Internal_Declaration_Kinds then
         return Not_A_Declaration_Origin;
      elsif not Is_From_Implicit (Declaration) then
         return An_Explicit_Declaration;
      elsif Is_From_Inherited (Declaration) then
         return An_Implicit_Inherited_Declaration;
      else
         return An_Implicit_Predefined_Declaration;
      end if;

   end Declaration_Origin;
-----------------------------------------------------------------------------

   function Mode_Kind (Declaration : in Asis.Declaration)
                   return Asis.Mode_Kinds
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Declaration);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Declaration, "Asis.Elements.Mode_Kind");

      if not (Arg_Kind = A_Parameter_Specification or else
              Arg_Kind = A_Formal_Object_Declaration)
      then
         return Not_A_Mode;
      end if;

      Arg_Node := Node (Declaration);

      if In_Present (Arg_Node) and Out_Present (Arg_Node) then
         return An_In_Out_Mode;
      elsif In_Present (Arg_Node) then
         return An_In_Mode;
      elsif Out_Present (Arg_Node) then
         return An_Out_Mode;
      else
         return A_Default_In_Mode;
      end if;
   end Mode_Kind;
-----------------------------------------------------------------------------

   function Default_Kind
               (Declaration : in Asis.Generic_Formal_Parameter)
               return Asis.Subprogram_Default_Kinds
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Declaration);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Declaration, "Asis.Elements.Default_Kind");

      Arg_Node := Node (Declaration);

      if not (Arg_Kind = A_Formal_Procedure_Declaration or else
              Arg_Kind = A_Formal_Function_Declaration)
      then
         return Not_A_Default;
      elsif Box_Present (Arg_Node) then
         return A_Box_Default;
      elsif Present (Default_Name (Arg_Node)) then
         return A_Name_Default;
      else
         return A_Nil_Default;
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Declaration,
            Outer_Call => "Asis.Elements.Default_Kind");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Declaration,
            Diagnosis => "Asis.Elements.Default_Kind");
   end Default_Kind;
-----------------------------------------------------------------------------

   function Definition_Kind (Definition : in Asis.Definition)
               return Asis.Definition_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Definition_Kind");
      return Definition_Kind_From_Internal (Int_Kind (Definition));
   end Definition_Kind;
-----------------------------------------------------------------------------

   function Type_Kind (Definition : in Asis.Type_Definition)
               return Asis.Type_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Type_Kind");
      return Type_Kind_From_Internal (Int_Kind (Definition));
   end Type_Kind;
-----------------------------------------------------------------------------

   function Formal_Type_Kind (Definition : in Asis.Type_Definition)
               return Asis.Formal_Type_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Formal_Type_Kind");
      return Formal_Type_Kind_From_Internal (Int_Kind (Definition));
   end Formal_Type_Kind;
-----------------------------------------------------------------------------

   function Access_Type_Kind (Definition : in Asis.Type_Definition)
               return Asis.Access_Type_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Access_Type_Kind");
      return Access_Type_Kind_From_Internal (Int_Kind (Definition));
   end Access_Type_Kind;
-----------------------------------------------------------------------------

   function Root_Type_Kind (Definition : in Asis.Type_Definition)
               return Asis.Root_Type_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Root_Type_Kind");
      return Root_Type_Kind_From_Internal (Int_Kind (Definition));
   end Root_Type_Kind;
-----------------------------------------------------------------------------

   function Constraint_Kind (Definition : in Asis.Definition)
               return Asis.Constraint_Kinds is
   begin
      Check_Validity (Definition, "Asis.Elements.Constraint_Kind");
      return Constraint_Kind_From_Internal (Int_Kind (Definition));
   end Constraint_Kind;
-----------------------------------------------------------------------------

   function Discrete_Range_Kind
                 (Definition : in Asis.Definition)
                 return Asis.Discrete_Range_Kinds is
   begin
      Check_Validity (Definition, "Discrete_Range_Kind.Expression_Kind");
      return Discrete_Range_Kind_From_Internal (Int_Kind (Definition));
   end Discrete_Range_Kind;

-----------------------------------------------------------------------------

   function Expression_Kind (Expression : in Asis.Expression)
               return Asis.Expression_Kinds is
   begin
      Check_Validity (Expression, "Asis.Elements.Expression_Kind");
      return Expression_Kind_From_Internal (Int_Kind (Expression));
   end Expression_Kind;
-----------------------------------------------------------------------------

   function Operator_Kind (Element : in Asis.Element)
               return Asis.Operator_Kinds is
   begin
      Check_Validity (Element, "Asis.Elements.Operator_Kind");
      return Operator_Kind_From_Internal (Int_Kind (Element));
   end Operator_Kind;
-----------------------------------------------------------------------------

   function Attribute_Kind (Expression : in Asis.Expression)
               return Asis.Attribute_Kinds is
   begin
      Check_Validity (Expression, "Asis.Elements.Attribute_Kind");
      return Attribute_Kind_From_Internal (Int_Kind (Expression));
   end Attribute_Kind;
-----------------------------------------------------------------------------

   function Association_Kind (Association : in Asis.Association)
               return Asis.Association_Kinds is
   begin
      Check_Validity (Association, "Asis.Elements.Association_Kind");
      return Association_Kind_From_Internal (Int_Kind (Association));
   end Association_Kind;
-----------------------------------------------------------------------------

   function Statement_Kind (Statement : in Asis.Statement)
               return Asis.Statement_Kinds is
   begin
      Check_Validity (Statement, "Asis.Elements.Statement_Kind");
      return Statement_Kind_From_Internal (Int_Kind (Statement));
   end Statement_Kind;
-----------------------------------------------------------------------------

   function Path_Kind (Path : in Asis.Path)
               return Asis.Path_Kinds is
   begin
      Check_Validity (Path, "Asis.Elements.Clause_Kind");
      return Path_Kind_From_Internal (Int_Kind (Path));
   end Path_Kind;
-----------------------------------------------------------------------------

   function Clause_Kind (Clause : in Asis.Clause)
               return Asis.Clause_Kinds is
   begin
      Check_Validity (Clause, "Asis.Elements.Clause_Kind");
      return Clause_Kind_From_Internal (Int_Kind (Clause));
   end Clause_Kind;
-----------------------------------------------------------------------------

   function Representation_Clause_Kind (Clause : in Asis.Clause)
               return Asis.Representation_Clause_Kinds is
   begin
      Check_Validity (Clause, "Asis.Elements.Representation_Clause_Kind");
      return Representation_Clause_Kind_From_Internal (Int_Kind (Clause));
   end Representation_Clause_Kind;
-----------------------------------------------------------------------------

   function Is_Nil (Right : in Asis.Element) return Boolean is
   begin
      return Right = Asis.Nil_Element;
   end Is_Nil;
-----------------------------------------------------------------------------

   function Is_Nil (Right : in Asis.Element_List) return Boolean is
   begin
      return Right'Length = 0;
   end Is_Nil;
-----------------------------------------------------------------------------

   function Is_Equal
     (Left  : in Asis.Element;
      Right : in Asis.Element) return Boolean
   is
      C_Left   : Context_Id;
      C_Right  : Context_Id;

      U_Left   : Unit_Id;
      U_Right  : Unit_Id;

      CU_Left  : Compilation_Unit;
      CU_Right : Compilation_Unit;

      N_Left   : Node_Id;
      N_Right  : Node_Id;

      Result   : Boolean := False;

   begin
      Check_Validity (Left,  "Asis.Elements.Is_Equal");
      Check_Validity (Right, "Asis.Elements.Is_Equal");

      --  To minimize the prformance penalties, we are trying to filter
      --  out simpe cases first. These are (more or less) simple cases
      --  when the function should return False

      --  First, checking the case when one of the arguments is Nil_Element

      if Int_Kind (Left)  = Not_An_Element or else
         Int_Kind (Right) = Not_An_Element
      then
         return (Int_Kind (Left) = Int_Kind (Right));
      end if;

      --  Then, we are checking if the basic properties of the argument are
      --  the same

      if not (Special_Case      (Left) = Special_Case      (Right) and then
              Int_Kind          (Left) = Int_Kind          (Right) and then
              Character_Code    (Left) = Character_Code    (Right) and then
              Is_From_Implicit  (Left) = Is_From_Implicit  (Right) and then
              Is_From_Inherited (Left) = Is_From_Inherited (Right) and then
              Is_From_Instance  (Left) = Is_From_Instance  (Right))
      then
         return False;
      end if;

      --  Now, checking that arguments are from the same Ada unit

      C_Left  := Encl_Cont_Id (Left);
      U_Left  := Encl_Unit_Id (Left);

      C_Right := Encl_Cont_Id (Right);
      U_Right := Encl_Unit_Id (Right);

      if C_Left = C_Right then

         if U_Left /= U_Right then
            return False;
         end if;

      else
         --  This case is a bit more complicated: we have to compare names
         --  and time stamps of enclosed units
         if U_Left = Standard_Id or else U_Right = Standard_Id then

            if U_Left /= U_Right then
               return False;
            end if;

         else

            if Time_Stamp (C_Left, U_Left) /=
               Time_Stamp (C_Right, U_Right)
            then
               return False;
            end if;

            --  Here we have to compare unit names. Let's check unit kind
            --  and class first

            CU_Left  := Encl_Unit (Left);
            CU_Right := Encl_Unit (Right);

            if not (Kind  (CU_Left) = Kind  (CU_Right) and then
                    Class (CU_Left) = Class (CU_Right))
            then
               return False;
            end if;

            --  And now - unit names. This case does not seem to be
            --  encountered very often, so we simply use Unit_Full_Name
            --  query to avoid manual Context switching:

            if Asis.Compilation_Units.Unit_Full_Name (CU_Left) /=
               Asis.Compilation_Units.Unit_Full_Name (CU_Right)
            then
               return False;
            end if;

         end if;

      end if;

      --  And if we are here, ve are in the following situation: both Left
      --  and Right are non-nil Elements, they have all their properties
      --  the same and they are from the same Compilation_Unit.
      --  And now we have to check if they represents the same construct.

      if U_Left = Standard_Id or else
         (C_Left = C_Right
         and then
          Encl_Tree (Left) = Encl_Tree (Right))
      then
         --  In Standard, we may just compare the node values.
         --  In the same tree we may do the same
         return R_Node (Left) = R_Node (Right);
      end if;

      --  And if we are here, we have to compare Elements obtained from
      --  different trees

      if not Is_From_Instance (Left) then
         --  May be, we have to use source-trace-based approach for
         --  all cases....????
         return Rel_Sloc (Left) = Rel_Sloc (Right);
      end if;

      --  If we are here, we have to compare node traces.

      Reset_Context (C_Left);

      N_Left := R_Node (Left);
      Create_Node_Trace (N_Left);

      Reset_Context (C_Right);

      N_Right := R_Node (Right);
      Result  := True;

      for J in Node_Trace.First .. Node_Trace.Last loop

         if No (N_Right) or else
            not Is_Equal (N_Right, Node_Trace.Table (J))
         then
            Result := False;
            exit;
         end if;

         N_Right := Enclosing_Scope (N_Right);

      end loop;

      return Result;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Outer_Call => "Asis.Elements.Is_Equal");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Diagnosis => "Asis.Elements.Is_Equal");
   end Is_Equal;

-----------------------------------------------------------------------------

   function Is_Identical
     (Left  : in Asis.Element;
      Right : in Asis.Element)
      return Boolean
   is
      C_Left  : Context_Id;
      C_Right : Context_Id;
   begin
      Check_Validity (Left,  "Asis.Elements.Is_Identical");
      Check_Validity (Right, "Asis.Elements.Is_Identical");

      C_Left  := Encl_Cont_Id (Left);
      C_Right := Encl_Cont_Id (Right);

      if C_Left /= C_Right then
         return False;
      else
         return Is_Equal (Left, Right);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Outer_Call => "Asis.Elements.Is_Identical");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Diagnosis => "Asis.Elements.Is_Identical");
   end Is_Identical;
------------------------------------------------------------------------------
--          The general principle of the implementation
--          of the Is_Part_Of_... functions:
--
--  These functions simply returns the corresponding flag value from the
--  Element passed as their argument. All necessary work should be done
--  during the creation of the Element when these flags are set
--
--  All of them (as well as the function Declaration_Origin abowe) will
--  require revisiting during semantic queries implementation
------------------------------------------------------------------------------

   function Is_Part_Of_Implicit (Element : in Asis.Element) return Boolean is
   begin
      Check_Validity (Element, "Asis.Elements.Is_Part_Of_Implicit");
      return Is_From_Implicit (Element) or else
             Special_Case (Element) = Is_Normalized;
      --  for normalized associations Is_Part_Of_Implicit is not set ON   ???
      --  unless the association is from some enclosing implicit construct. ???
   end Is_Part_Of_Implicit;
-----------------------------------------------------------------------------

   function Is_Part_Of_Inherited (Element : in Asis.Element) return Boolean is
   begin
      Check_Validity (Element, "Asis.Elements.Is_Part_Of_Inherited");
      return Is_From_Inherited (Element);
   end Is_Part_Of_Inherited;
-----------------------------------------------------------------------------

   function Is_Part_Of_Instance (Element : Asis.Element) return Boolean is
   begin
      Check_Validity (Element, "Asis.Elements.Is_Part_Of_Instance");
      return Is_From_Instance (Element);
   end Is_Part_Of_Instance;
-----------------------------------------------------------------------------
   function Enclosing_Element
     (Element : in Asis.Element)
      return Asis.Element
   is
      Argument_Kind : Internal_Element_Kinds := Int_Kind (Element);
      Arg_Spec_Case : Special_Cases          := Special_Case (Element);
   begin
      Check_Validity (Element, "Asis.Elements.Enclosing_Element");

      if Argument_Kind = Not_An_Element then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Elements.Enclosing_Element");
      end if;

      --  if the argument is an expanded generic declaration we have
      --  to return the corresponding instantiation:
      if Arg_Spec_Case in Expanded_Spec then
         return Corresponding_Instantiation (Element);
      end if;

      --  if the argument is from an expanded generic declaration,
      --  we have to be careful when coming from some top-level component
      --  of the expanded declaration to the declaration itself - we
      --  need to set the Special_Case field properly

      if Is_From_Instance (Element) and then
         not Is_From_Implicit (Element)
      then
         return Enclosing_For_Explicit_Instance_Component (Element);
      end if;

      if not (Is_From_Implicit (Element) or else
              Is_From_Inherited (Element))  --  ???
      then
         return Enclosing_Element_For_Explicit (Element);
      else
         return Enclosing_Element_For_Implicit (Element);
      end if;

   exception
      when Assert_Error : System.Assertions.Assert_Failure =>
         Raise_ASIS_Failed (
            Argument   => Element,
            Diagnosis =>
                "Asis.Elements.Enclosing_Element - "  & LT
              & "Assert_Failure at "
              &  Ada.Exceptions.Exception_Message (Assert_Error));
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>

         Add_Call_Information (
            Argument   => Element,
            Outer_Call => "Asis.Elements.Enclosing_Element");

         raise;
      when others =>

         Raise_ASIS_Failed (
            Argument   => Element,
            Diagnosis => "Asis.Elements.Enclosing_Element");
   end Enclosing_Element;
------------------------------------------------------------------------------

   function Enclosing_Element
     (Element                    : in Asis.Element;
      Expected_Enclosing_Element : in Asis.Element)
      return Asis.Element
   is
   begin
      Check_Validity (Element,  "Asis.Elements.Enclosing_Element "
                              & "(the Element parameter)");
      Check_Validity (Expected_Enclosing_Element,
                                "Asis.Elements.Enclosing_Element "
                              & "(the Expected_Enclosing_Element parameter)");
      return Enclosing_Element (Element);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Element,
            Outer_Call => "Asis.Elements.Enclosing_Element");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Element,
            Diagnosis => "Asis.Elements.Enclosing_Element");
   end Enclosing_Element;
-----------------------------------------------------------------------------
   function Pragmas
     (The_Element : in Asis.Element)
      return Asis.Pragma_Element_List
   is

--  This implementation is based on the following statement in the function
--  documentation:
--
--  This interface returns exactly those pragmas that would be returned by the
--  various interfaces, that accept these same argument kinds, and that
--  return Declaration_Lists and Statement_Lists, where the inclusion of
--  Pragmas is controlled by an Include_Pragmas parameter.
--
--  The general idea of the implementation is straightforward - to get
--  the "full" Element_List by the call of the corresponding interface
--  with Include_Pragmas => True, and then select only A_Pragma elements
--  from this intermediate result.
--
--  Some loss of effectiveness could be considered as the disadvantage of
--  this approach, but its advantages are:
--
--   - it saves implementation efforts;
--   - it allows to check whether the documentation fragment cited above
--     is really correct;
--   - it saves the debugging efforts on the first prototyping stage
--     (there is no need for the special debugging of this function
--     if other ASIS interfaces used for its implementation work correctly);
--   - it is more convenient for for incremental development
--   - it yields the vendor-independent implementation of this function

      Context_Internal_Kind : Internal_Element_Kinds;

      function Extract_Pragmas
        (List : Asis.Element_List)
         return Asis.Pragma_Element_List;
      --  function extracts Elements of A_Pragma kind from its
      --  List parameter and returns the new List constructed from these
      --  Pragma Elements (in their order of appearance) as its result

      function Extract_Pragmas
        (List : Asis.Element_List)
         return Asis.Pragma_Element_List
      is
         Pragma_List               : Asis.Pragma_Element_List (List'Range);
         Pragma_List_Actual_Lenght : Asis.ASIS_Integer := 0;

      begin

         for I in List'Range loop

            if Element_Kind (List (I)) = A_Pragma then
               Pragma_List_Actual_Lenght := Pragma_List_Actual_Lenght + 1;
               Pragma_List (Pragma_List_Actual_Lenght) := List (I);
            end if;

         end loop;

         return Pragma_List (1 .. Pragma_List_Actual_Lenght);

      end Extract_Pragmas;

   begin -- Pragmas

      Check_Validity (The_Element, "Asis.Elements.Pragmas");

      Context_Internal_Kind := Int_Kind (The_Element);

      if not -- Appropriate Element_Kinds:

             (Context_Internal_Kind in Internal_Path_Kinds
            or Context_Internal_Kind =  An_Exception_Handler


            --  Appropriate Declaration_Kinds:

            or Context_Internal_Kind =  A_Procedure_Body_Declaration
            or Context_Internal_Kind =  A_Function_Body_Declaration
            or Context_Internal_Kind =  A_Package_Declaration
            or Context_Internal_Kind =  A_Package_Body_Declaration
            or Context_Internal_Kind =  A_Task_Body_Declaration
            or Context_Internal_Kind =  A_Protected_Body_Declaration
            or Context_Internal_Kind =  An_Entry_Body_Declaration
            or Context_Internal_Kind =  A_Generic_Procedure_Declaration
            or Context_Internal_Kind =  A_Generic_Function_Declaration
            or Context_Internal_Kind =  A_Generic_Package_Declaration


            --  Appropriate Definition_Kinds:

            or Context_Internal_Kind =  A_Record_Definition
            or Context_Internal_Kind =  A_Variant_Part
            or Context_Internal_Kind =  A_Variant
            or Context_Internal_Kind =  A_Task_Definition
            or Context_Internal_Kind =  A_Protected_Definition


            --  Appropriate Statement_Kinds:

            or Context_Internal_Kind =  A_Loop_Statement
            or Context_Internal_Kind =  A_While_Loop_Statement
            or Context_Internal_Kind =  A_For_Loop_Statement
            or Context_Internal_Kind =  A_Block_Statement
            or Context_Internal_Kind =  An_Accept_Statement
            --  Representation_Clause_Kinds:
            or Context_Internal_Kind = A_Record_Representation_Clause)
      then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Elements.Pragmas");
      end if;

      begin
         --  ???
         --  for the debugging period only!!!
         --  to add the context information to diagnosis for
         --  ASIS_Inappropriate_Element raised by other ASIS interfaces
         --
         --  should be better documented


         case Context_Internal_Kind is

            --  Appropriate Element_Kinds:

            when Internal_Path_Kinds =>
               --  A_Path: (pragmas from the statement list)

               return Extract_Pragmas (
                      Asis.Statements.Sequence_Of_Statements (
                          Path            => The_Element,
                          Include_Pragmas => True));

            when An_Exception_Handler =>
               --  (pragmas from the statement list)

               return Extract_Pragmas (
                      Asis.Statements.Handler_Statements (
                          Handler         => The_Element,
                          Include_Pragmas => True));

--  Appropriate Declaration_Kinds:

            when A_Procedure_Body_Declaration  -- (pragmas from decl region
               | A_Function_Body_Declaration   --  + statements)
               | A_Package_Body_Declaration    -- !! SEE OPEN_PROBLEMS.1 BELOW
               | A_Task_Body_Declaration
               | An_Entry_Body_Declaration =>

               return (Extract_Pragmas (
                           Asis.Declarations.Body_Declarative_Items (
                               Declaration     => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                            Asis.Declarations.Body_Statements (
                               Declaration     => The_Element,
                               Include_Pragmas => True)));

            when A_Package_Declaration =>
               --  (pragmas from visible + private decl regions)
               return (Extract_Pragmas (
                           Asis.Declarations.Visible_Part_Declarative_Items (
                               Declaration     => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                           Asis.Declarations.Private_Part_Declarative_Items (
                               Declaration     => The_Element,
                               Include_Pragmas => True)));

            when A_Protected_Body_Declaration =>
               --  (pragmas from decl region)

               return Extract_Pragmas (
                         Asis.Declarations.Protected_Operation_Items (
                             Declaration     => The_Element,
                             Include_Pragmas => True));

            when A_Generic_Procedure_Declaration
               | A_Generic_Function_Declaration =>

               --  (pragmas from formal decl region
               return Extract_Pragmas (
                         Asis.Declarations.Generic_Formal_Part (
                             Declaration     => The_Element,
                             Include_Pragmas => True));

            when A_Generic_Package_Declaration =>
               --  (pragmas from formal + visible + private decl regions)
               return (Extract_Pragmas (
                           Asis.Declarations.Generic_Formal_Part (
                               Declaration     => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                           Asis.Declarations.Visible_Part_Declarative_Items (
                               Declaration     => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                           Asis.Declarations.Private_Part_Declarative_Items (
                               Declaration     => The_Element,
                               Include_Pragmas => True)));

--  Appropriate Definition_Kinds:

            when   A_Record_Definition
                 | A_Variant           =>

               --  (pragmas from the component list)

               return Extract_Pragmas (
                         Asis.Definitions.Record_Components (
                             Definition        => The_Element,
                             Include_Pragmas   => True));

            when A_Variant_Part =>
               --  (pragmas from between variants)

               return Extract_Pragmas (
                         Asis.Definitions.Variants (
                             Variant_Part    => The_Element,
                             Include_Pragmas => True));

            when A_Task_Definition
               | A_Protected_Definition =>

               --  (pragmas from visible + private decl regions)
               return (Extract_Pragmas (
                           Asis.Definitions.Visible_Part_Items (
                               Definition      => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                           Asis.Definitions.Private_Part_Items (
                               Definition      => The_Element,
                               Include_Pragmas => True)));

--  Appropriate Statement_Kinds:

            when A_Loop_Statement
               | A_While_Loop_Statement
               | A_For_Loop_Statement =>

               --  (pragmas from statement list)

               return Extract_Pragmas (
                        Asis.Statements.Loop_Statements (
                            Statement       => The_Element,
                            Include_Pragmas => True));

            when A_Block_Statement =>
            --  (pragmas from decl region + statements)

               return (Extract_Pragmas (
                           Asis.Statements.Block_Declarative_Items (
                               Statement       => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                            Asis.Statements.Block_Statements (
                               Statement       => The_Element,
                               Include_Pragmas => True)));

            when An_Accept_Statement =>
               --  (pragmas from statement list+ pragma immediately preceding
               --  the first  exception handler, if any)
               --  !! SEE OPEN_PROBLEMS.2 BELOW
               return (Extract_Pragmas (
                           Asis.Statements.Accept_Body_Statements (
                               Statement       => The_Element,
                               Include_Pragmas => True))
                      &
                         Extract_Pragmas (
                            Asis.Statements.Accept_Body_Exception_Handlers (
                               Statement       => The_Element,
                               Include_Pragmas => True)));

--  Appropriate Representation_Clause_Kinds:

            when A_Record_Representation_Clause =>
               --  (pragmas from component specifications)

               return Extract_Pragmas (
                        Asis.Clauses.Component_Clauses (
                            Clause          => The_Element,
                            Include_Pragmas => True));

            when others => -- could never been reached !!!
               Raise_ASIS_Failed (Diagnosis =>
                                   "Internal Error in Asis_Elements.Pragmas");

               return Nil_Element_List; -- to avoid GNAT warnings;


         end case;

      exception
         --   ??? for the debugging period only!!!

         when ASIS_Inappropriate_Element =>
            Add_Call_Information (Outer_Call => "Asis.Elements.Pragmas");
            raise;
      end;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => The_Element,
            Outer_Call => "Asis.Elements.Pragmas");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => The_Element,
            Diagnosis => "Asis.Elements.Pragmas");
   end Pragmas;
------------------------------------------------------------------------------
--  NOT IMPLEMENTED

   function Corresponding_Pragmas (Element : in Asis.Element)
                               return Asis.Pragma_Element_List is
   begin
      Check_Validity (Element, "Asis.Elements.Corresponding_Pragmas");

      Not_Implemented_Yet (Diagnosis => "Asis.Elements.Corresponding_Pragmas");
      --  ASIS_Failed is raised, Not_Implemented_Error status is setted

      return Nil_Element_List; -- to make the code syntactically correct

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Element,
            Outer_Call => "Asis.Elements.Corresponding_Pragmas");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Element,
            Diagnosis => "Asis.Elements.Corresponding_Pragmas");
   end Corresponding_Pragmas;
-----------------------------------------------------------------------------

   function Pragma_Name_Image
     (Pragma_Element : in Asis.Pragma_Element)
      return Wide_String
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Pragma_Element);
      Arg_Node : Node_Id;

      Image_Start : Source_Ptr;
      Image_End   : Source_Ptr;
   begin
      Check_Validity (Pragma_Element, "Asis.Elements.Pragma_Name_Image");
      if Arg_Kind not in Internal_Pragma_Kinds then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Elements.Pragma_Name_Image");
      end if;
      Arg_Node := Node (Pragma_Element);
      Image_Start := Next_Identifier (Sloc (Arg_Node) + 5);
      Image_End   := Get_Word_End (P       => Image_Start,
                                   In_Word => In_Identifier'Access);

      return To_Program_Text (Get_Word (Image_Start, Image_End));
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Pragma_Element,
            Outer_Call => "Asis.Elements.Pragma_Name_Image");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Pragma_Element,
            Diagnosis => "Asis.Elements.Pragma_Name_Image");
   end Pragma_Name_Image;
-----------------------------------------------------------------------------

   function Pragma_Argument_Associations
        (Pragma_Element : in Asis.Pragma_Element)
     return Asis.Association_List
   is
      Arg_Kind     : Internal_Element_Kinds := Int_Kind (Pragma_Element);
      Arg_Node     : Node_Id;

      Pragma_Chars : Name_Id;
   begin

      Check_Validity (Pragma_Element,
               "Asis.Elements.Pragma_Argument_Associations");

      if Arg_Kind not in Internal_Pragma_Kinds then
         Raise_ASIS_Inappropriate_Element
                  (Diagnosis => "Asis.Elements.Pragma_Argument_Associations");
      end if;

      Arg_Node     := Node (Pragma_Element);
      Pragma_Chars := Chars (Arg_Node);

      return N_To_E_List_New
               (List             => Pragma_Argument_Associations (Arg_Node),
                Internal_Kind    => A_Pragma_Argument_Association,
                Starting_Element => Pragma_Element);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Pragma_Element,
            Outer_Call => "Asis.Elements.Pragma_Argument_Associations");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument   => Pragma_Element,
            Diagnosis => "Asis.Elements.Pragma_Argument_Associations");
   end Pragma_Argument_Associations;
-----------------------------------------------------------------------------

   function Debug_Image (Element : in Asis.Element) return Wide_String is
      LT : String renames A4G.A_Types.ASIS_Line_Terminator;
   begin
      Debug_String (Element);
      return To_Wide_String (
         LT & "Element Debug_Image: " & LT &
         Debug_Buffer (1 .. Debug_Buffer_Len));
   end Debug_Image;
-----------------------------------------------------------------------------

   --  The following constants are used in the computation of hash values for
   --  Elements which are not from Standard:

   Line_Pos  : constant Natural := 6;
   Bit_Pos   : constant Natural := 1;
   Impl_Pos  : Natural renames Bit_Pos;
   Inh_Pos   : Natural renames Bit_Pos;
   Inst_Pos  : Natural renames Bit_Pos;
   Kind_Pos  : constant Natural := 8;
   Col_Pos   : constant Natural := 4;
   Unit_Pos  : constant Natural := 9;
   Spec_Pos  : constant Natural := 2;

   Max_Units : constant Unsigned_32 := 2 ** Unit_Pos;
   Max_Cols  : constant Unsigned_32 := 2 ** Col_Pos;
   Max_Kinds : constant Unsigned_32 := 2 ** Kind_Pos;
   Max_Lines : constant Unsigned_32 := 2 ** Line_Pos;
   Max_Specs : constant Unsigned_32 := 2 ** Spec_Pos;

   function Hash (Element : in Asis.Element) return Asis.ASIS_Integer is
      N : Node_Id;
      S : Source_Ptr;

      L : Physical_Line_Number;
      C : Column_Number;

      Result : Unsigned_32 := 0;

      function To_ASIS_Integer is new
         Ada.Unchecked_Conversion
           (Source => Unsigned_32,
            Target => Asis.ASIS_Integer);

   begin
      Check_Validity (Element, "Asis.Elements.Hash");

      --  The hash value for Elements is first created as 32-bit unsigned
      --  integer and then converted into ASIS_Integer
      --
      --  Different approaches are used to create this 32-bit unsigned
      --  integer value for Elements which are and which are not from the
      --  predefined Standerd package.
      --
      --  For Elements from Standard:
      --  -  If Element represents the An_Enumeration_Literal_Specification
      --     or A_Defining_Character_Literal from types Character or
      --     Standard_Character, the corresponding character code is used
      --     as hash value
      --  -  otherwise the Node Id of the Element is used as hash value;
      --
      --  For Elements which are not from Standard the 32 bits are first
      --  filled in by the following information:
      --
      --   0 ..  8 - the Id of the enclosed unit
      --         9 - Is_Part_Of_Implicit
      --  10 .. 13 - column in the source file computed from the Sloc of
      --             Element's Node reference
      --        14 - Is_Part_Of_Inherited
      --  15 .. 22 - Internal kind (converted to 'Pos value)
      --        23 - Is_Part_Of_Instance
      --  24 .. 29 - line in the source file computed from the Sloc of
      --             Element's Node reference
      --  30 .. 31 - Special_Case (converted to 'Pos value)
      --
      --  All the values are reduced modulo the corresponding values to fit
      --  the correspinding range. In case of extended generic code, line
      --  and column are computed as the sum of all the lines and columns
      --  in the chain of the source references correspponding to the
      --  instantiation
      --
      --  After creating such a value, it is rotated rignt by the number of
      --  the lines computed from Sloc of Element's Node reference

      if Encl_Unit_Id (Element) = Standard_Id then

         if Character_Code (Element) /= 0 then
            Result := Result + (Unsigned_32 (Character_Code (Element)));
         else
            N := Node_Value (Element);
            Result := Unsigned_32 (N);
         end if;

      else

         N := Node (Element);
         S := Sloc (N);

         L := Get_Physical_Line_Number (Sloc (N));
         C := Get_Column_Number        (Sloc (N));
         S := Instantiation_Location   (S);

         while S /= No_Location loop
            L := L + Get_Physical_Line_Number (Sloc (N));
            C := C + Get_Column_Number        (Sloc (N));
            S := Instantiation_Location       (S);
         end loop;

         --  Special Case:
         Result := Result +
            (Unsigned_32 (
               Special_Cases'Pos (Special_Case (Element))) mod Max_Specs);

         Result := Shift_Left (Result, Line_Pos);

         --  Line:
         Result := Result + (Unsigned_32 (L) mod Max_Lines);
         Result := Shift_Left (Result, Inst_Pos);

         --  Is_Part_Of_Instance
         if Is_From_Instance (Element) then
            Result := Result + 1;
         end if;
         Result := Shift_Left (Result, Kind_Pos);

         --  Internal kind:
         Result := Result + Unsigned_32
           (Internal_Element_Kinds'Pos (Int_Kind (Element)) mod Max_Kinds);
         Result := Shift_Left (Result, Inh_Pos);

         --  Is_Part_Of_Inherited
         if Is_From_Inherited (Element) then
            Result := Result + 1;
         end if;
         Result := Shift_Left (Result, Col_Pos);

         --  Column:
         Result := Result + (Unsigned_32 (C) mod Max_Cols);
         Result := Shift_Left (Result, Impl_Pos);

         --  Is_Part_Of_Implicit:
         if Is_From_Implicit (Element) then
            Result := Result + 1;
         end if;
         Result := Shift_Left (Result, Unit_Pos);

         Result := Result +
           ((Unsigned_32 ((Encl_Unit_Id (Element) - 2))) mod Max_Units);

         --  And now, rotating Result

         Result := Rotate_Right (Result, Natural (L));
      end if;

      return To_ASIS_Integer (Result);

   end Hash;
-----------------------------------------------------------------------------
end Asis.Elements;
