File : asis-elements.adb


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                        A S I S . E L E M E N T S                         --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--            Copyright (c) 1995-1999, 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 Asis.Exceptions;         use Asis.Exceptions;
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 Types;                   use Types;
with Sinfo;                   use Sinfo;
with Atree;                   use Atree;
with Stand;                   use Stand;
with Snames;                  use Snames;
with Nlists;                  use Nlists;

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;
      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 (Top (Compilation_Unit));

      return Node_To_Element_List (
                   List           => List_Before,
                   In_Unit        => Compilation_Unit,
                   To_Be_Included => Only_Pragmas'Access)
         &
             Node_To_Element_List (
                   List           => List_After,
                   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;
   begin
      Check_Validity (Left,  "Asis.Elements.Is_Equal");
      Check_Validity (Right, "Asis.Elements.Is_Equal");

      if Left = Nil_Element or else Right = Nil_Element then

         return Left = Right;

      elsif not (Rel_Sloc          (Left) = Rel_Sloc          (Right) and then
                 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;
      else
         --  here we have to check if Left and Right are from
         --  the same physical compilation unit. For now,
         --  the same physical compilation unit means the same time stamp
         --  of the source files.
         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 U_Left = Standard_Id and then U_Right = Standard_Id then
            --  When we are in the predefined Standard package, Rel_Sloc
            --  comparition does not work, and we have to compare nodes:
            return Node_Value (Left) = Node_Value (Right);
         elsif C_Left = C_Right then
            return U_Left = U_Right;
         else
            --  This is the less reliable case: if we have two Elements
            --  which came from _different_ Contexts, we have to check if
            --  enlocing units are Is_Equal. Currently we use time stamps
            --  comparing for this, but we akready have at least one
            --  proof that it may be unreliable
            return Time_Stamp (C_Left, U_Left) = Time_Stamp (C_Right, U_Right);
         end if;
      end if;

   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
   begin
      Check_Validity (Left,  "Asis.Elements.Is_Identical");
      Check_Validity (Right, "Asis.Elements.Is_Identical");

      return Rel_Sloc          (Left) = Rel_Sloc          (Right) and then
             Int_Kind          (Left) = Int_Kind          (Right) and then
             Special_Case      (Left) = Special_Case      (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) and then
             Encl_Unit_Id      (Left) = Encl_Unit_Id      (Right) and then
             Encl_Cont_Id      (Left) = Encl_Cont_Id      (Right);
   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;

      --  At last, we've started revising of the old implementation
      --  of Enclosind_Element

      --  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);
         --  NEEDS ADDITIONAL REVISING!!!
      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;

   --  OPEN PROBLEMS:
   --
   --  1. If we are in an expanded generic template...
------------------------------------------------------------------------------
--  DEPENDS ON THE PARTIALLY IMPLEMENTED Enclosing_Element FUNCTION WITH
--  ONE PARAMETER

   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) + 6);
      Image_End   := Get_Word_End (P       => Image_Start,
                                   In_Word => In_Identifier'Access);

      return To_Wide_String (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;
      Res_Node     : Node_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);

      if Pragma_Chars = Name_Debug then
         --  GNAT-specific debug pragma has a procedure call as its argument,
         --  so it needs a special processing
         Arg_Node := R_Node (Pragma_Element);
         Res_Node := Nlists.First (Pragma_Argument_Associations (Arg_Node));
         --  Here we have Res_Node set to N_Procedure_Call_Statement node
         Res_Node := Sinfo.Name (Res_Node);

         return (1 => Node_To_Element_New
                        (Node             => Res_Node,
                         Starting_Element => Pragma_Element));

      else

         return Node_To_Element_List (
                List    => Pragma_Argument_Associations (Arg_Node),
                In_Unit => Encl_Unit (Pragma_Element));
      end if;

   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;
-----------------------------------------------------------------------------

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

      if Encl_Unit_Id (Element) = Standard_Id then
         if Special_Case (Element) = Stand_Char_Literal then
            return Asis.ASIS_Integer (256 * Character_Code (Element));
         else
            return Asis.ASIS_Integer (Node_Value (Element));
         end if;
      else
         return Asis.ASIS_Integer (Rel_Sloc (Element));
      end if;

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