File : asis-statements.adb


------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                        A S I S . S T A T 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).                                                   --
--                                                                          --
------------------------------------------------------------------------------

--  ASIS-specific contex clauses:

with Asis.Exceptions;   use Asis.Exceptions;
with Asis.Elements;     use Asis.Elements;
with Asis.Declarations; use Asis.Declarations;
with Asis.Expressions;  use Asis.Expressions;
with Asis.Extensions;   use Asis.Extensions;

--  Implementation-specific contex clauses:

with Asis.Set_Get;
use  Asis.Set_Get;

with A4G.Int_Knds;    use A4G.Int_Knds;
with A4G.Mapping;     use A4G.Mapping;
with A4G.Vcheck;      use A4G.Vcheck;
with A4G.A_Sem;       use A4G.A_Sem;
with A4G.A_Sinput;    use A4G.A_Sinput;
with A4G.Span_End;    use A4G.Span_End;
with Asis.Extensions; use Asis.Extensions;

--  GNAT-specific contex clauses:

with Types;    use Types;
with Sinfo;    use Sinfo;
with Nlists;   use Nlists;
with Atree;    use Atree;
with Sinput;   use Sinput;

package body Asis.Statements is

   --  !!!??? This file is '-gnatg-compilable', but both its content and its
   --  !!!???  documentation need revising

   LT : String renames ASIS_Line_Terminator;

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

   function Label_Names (Statement : in Asis.Statement)
      return Asis.Defining_Name_List
   is
      Arg_Kind      : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node      : Node_Id;
      Labels_Number : Nat := 0;  -- how many labels the statement has
      Label_Node    : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Label_Names");

      if not (Arg_Kind in Internal_Statement_Kinds) then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.Label_Names");
      end if;

      Arg_Node := Node (Statement);

      if not Is_List_Member (Arg_Node) then
      --  the accept statement in accept alternative, it cannot
      --  have lables at all
         return Nil_Element_List;
      end if;

      Label_Node := Prev (Arg_Node);

      while Nkind (Label_Node) = N_Label loop
         Labels_Number := Labels_Number + 1;
         Label_Node    := Prev (Label_Node);
      end loop;

      --  Label_Node is not the Node of N_Label kind now

      if Labels_Number = 0 then
         return Nil_Element_List;
      else
         declare

            Result_List : Asis.Element_List
                          (1 .. ASIS_Integer (Labels_Number));

         begin

            if Label_Node = Empty then
               --  special case: the first statement in the statement
               --  sequence is labeled
               Label_Node := First (List_Containing (Arg_Node));
            else
               Label_Node := Next (Label_Node);
            end if;

            --  the first label attached to the statement and the number of
            --  attached lables are obtained

         --  forming the result:

            for I in 1 .. ASIS_Integer (Labels_Number) loop
            --  the order of labels is important !
               Result_List (I) := Node_To_Element_New (
                     Node             => Label_Node,
                     Internal_Kind    => A_Defining_Identifier,
                     Starting_Element => Statement);

               Label_Node    := Next (Label_Node);

            end loop;
            return Result_List;
         end;
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Label_Names");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Label_Names");
   end Label_Names;
-----------------------------------------------------------------------------

   function Assignment_Variable_Name (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Assignment_Name");

      if not (Arg_Kind = An_Assignment_Statement) then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.Assignment_Name");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
                     Node             => Sinfo.Name (Arg_Node),
                     Starting_Element => Statement);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Assignment_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Assignment_Name");
   end Assignment_Variable_Name;
-----------------------------------------------------------------------------

   function Assignment_Expression (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Assignment_Expression");

      if not (Arg_Kind = An_Assignment_Statement) then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.Assignment_Expression");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
                       Node             => Sinfo.Expression (Arg_Node),
                       Starting_Element => Statement);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Assignment_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Assignment_Expression");
   end Assignment_Expression;
-----------------------------------------------------------------------------

   function Statement_Paths (Statement       : in Asis.Statement;
                             Include_Pragmas : in Boolean := False)
      return Asis.Path_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;

      Path_List_Length : ASIS_Integer;  -- Length of returned list
      Elsif_Or_Length  : ASIS_Integer;  -- Number of Elsif or Or paths
      Else_Present     : Boolean;

   begin

      Check_Validity (Statement, "Asis.Statements.Statement_Paths");

      if not (Arg_Kind = An_If_Statement
            or Arg_Kind = A_Case_Statement
            or Arg_Kind = A_Selective_Accept_Statement
            or Arg_Kind = A_Timed_Entry_Call_Statement
            or Arg_Kind = A_Conditional_Entry_Call_Statement
            or Arg_Kind = An_Asynchronous_Select_Statement)
      then
         Raise_ASIS_Inappropriate_Element
                (Diagnosis => "Asis.Statements.Statement_Paths");
      end if;

      Arg_Node := Node (Statement);

      case  Arg_Kind is
         when An_If_Statement =>

            Path_List_Length := 1; -- An_If_Path
            Else_Present := Present (Else_Statements (Arg_Node));

            if Else_Present then
               Path_List_Length := Path_List_Length + 1;
            end if;

            if Present (Elsif_Parts (Arg_Node)) then
               Elsif_Or_Length := ASIS_Integer
                                    (List_Length (Elsif_Parts (Arg_Node)));
            else
               Elsif_Or_Length := 0;
            end if;

            Path_List_Length := Path_List_Length + Elsif_Or_Length;

            declare
               Path_List : Asis.Element_List (1 .. Path_List_Length);
            begin         -- Element List to be returned by the function

               Path_List (1) := Node_To_Element_New
                       (Node             => Arg_Node,
                        Internal_Kind    => An_If_Path,
                        Starting_Element => Statement);

               Path_List (2 .. Elsif_Or_Length + 1) := Node_To_Element_List
                        (List          => Elsif_Parts (Arg_Node),
                          Internal_Kind => An_Elsif_Path,
                          In_Unit       => Encl_Unit (Statement));

               if Else_Present then
                  Path_List (Path_List_Length) := Node_To_Element_New
                       (Node             => Arg_Node,
                        Internal_Kind    => An_Else_Path,
                        Starting_Element => Statement);

               end if;

               return Path_List;
            end;

         when A_Case_Statement =>
            --  only here the value of Include_Pragmas is important

            if Include_Pragmas then
               return N_To_E_List_With_Pragmas
                     (List    => Alternatives (Arg_Node),
                      In_Unit => Encl_Unit (Statement));
            else
               return N_To_E_List_Without_Pragmas
                     (List    => Alternatives (Arg_Node),
                      In_Unit => Encl_Unit (Statement));
            end if;
         when A_Selective_Accept_Statement =>

            Elsif_Or_Length := ASIS_Integer
                (List_Length (Select_Alternatives (Arg_Node)));

            Path_List_Length := Elsif_Or_Length;

            Else_Present := Present (Else_Statements (Arg_Node));

            if Else_Present then
               Path_List_Length := Path_List_Length + 1;
            end if;

            declare
               Path_List : Asis.Element_List (1 .. Path_List_Length);
            begin         -- Element List to be returned by the function

               Path_List (1 .. Elsif_Or_Length) := Node_To_Element_List
                        (List    => Select_Alternatives (Arg_Node),
                          In_Unit => Encl_Unit (Statement));

               if Else_Present then
                  Path_List (Path_List_Length) := Node_To_Element_New
                       (Node             => Arg_Node,
                        Internal_Kind    => An_Else_Path,
                        Starting_Element => Statement);

               end if;

               return Path_List;
            end;

         when A_Timed_Entry_Call_Statement =>
            return Asis.Path_List' (
             1 =>  Node_To_Element_New (
                     Node             => Entry_Call_Alternative (Arg_Node),
                     Internal_Kind    => A_Select_Path,
                     Starting_Element => Statement),

             2 =>  Node_To_Element_New (
                     Node             => Delay_Alternative (Arg_Node),
                     Internal_Kind    => An_Or_Path,
                     Starting_Element => Statement));

         when A_Conditional_Entry_Call_Statement =>
            return Asis.Path_List' (
             1 =>  Node_To_Element_New (
                     Node             => Entry_Call_Alternative (Arg_Node),
                     Internal_Kind    => A_Select_Path,
                     Starting_Element => Statement),

             2 =>  Node_To_Element_New (
                     Node             => Arg_Node,
                     Internal_Kind    => An_Else_Path,
                     Starting_Element => Statement));

         when An_Asynchronous_Select_Statement =>
            return Asis.Path_List' (
             1 =>  Node_To_Element_New (
                     Node             => Triggering_Alternative (Arg_Node),
                     Internal_Kind    => A_Select_Path,
                     Starting_Element => Statement),

             2 =>  Node_To_Element_New (
                     Node             => Abortable_Part (Arg_Node),
                     Internal_Kind    => A_Then_Abort_Path,
                     Starting_Element => Statement));

         when others =>
            raise ASIS_Failed;
            --  this choice can never be reached, see the condition
            --  for defining the appropriate element
      end case;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Statement_Paths");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Statement_Paths");
   end Statement_Paths;
-----------------------------------------------------------------------------

   function Condition_Expression (Path : in Asis.Path) return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Path);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Path, "Asis.Statements.Condition_Expression");

      if not (Arg_Kind = An_If_Path or
              Arg_Kind = An_Elsif_Path)
      then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.Condition_Expression");
      end if;

      Arg_Node := Node (Path);

      return Node_To_Element_New (Node             => Condition (Arg_Node),
                                  Starting_Element => Path);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Path,
            Outer_Call => "Asis.Statements.Condition_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Path,
            Diagnosis => "Asis.Statements.Condition_Expression");
   end Condition_Expression;
-----------------------------------------------------------------------------

   function Sequence_Of_Statements
     (Path            : in Asis.Path;
      Include_Pragmas : in Boolean := False)
      return Asis.Statement_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Path);
      Arg_Node : Node_Id;

      Result_List    : List_Id;
      --  for processing An_If_Path, An_Elsif_Path, An_Else_Path, A_Case_Path
      --  and A_Then_Abort_Path arguments; the node of such argument has
      --  regular structure

      --  local variables for processing A_Select_Path and An_Or_Path
      --  arguments; the node of such arguments has irregular structure
      Statement_List        : List_Id;
      First_Element         : Asis.Element := Nil_Element;
      Alternative_Node_Kind : Node_Kind;

      Incl_Cond      : Inclusion_Condition;

   begin

      Check_Validity (Path, "Asis.Statements.Sequence_Of_Statements");

      if not (Arg_Kind in Internal_Path_Kinds) then
         Raise_ASIS_Inappropriate_Element (Diagnosis =>
                     "Asis.Statements.Sequence_Of_Statements");
      end if;

      Arg_Node := Node (Path);

      if Include_Pragmas then
         Incl_Cond := Every_Node'Access;
      else
         Incl_Cond := No_Pragma'Access;
      end if;

      case Arg_Kind is
         when An_If_Path | An_Elsif_Path =>

            Result_List := Then_Statements (Arg_Node);
         when An_Else_Path  =>

            Result_List := Else_Statements (Arg_Node);
         when A_Case_Path   =>

            Result_List := Sinfo.Statements (Arg_Node);
         when A_Then_Abort_Path =>

            Result_List := Sinfo.Statements (Arg_Node);

         when A_Select_Path | An_Or_Path =>

            Alternative_Node_Kind := Nkind (Arg_Node);

            if Alternative_Node_Kind = N_Terminate_Alternative then

            --  special case: result list contains only one dummy terminate
            --  statement; no tree traversing needed: the result is based
            --  on the same node as the argument

               return Asis.Statement_List'(
                1 => Node_To_Element_New (
                         Node             => Arg_Node,
                         Internal_Kind    => A_Terminate_Alternative_Statement,
                         Starting_Element => Path));

            else
               --  this alternative corresponds to the situation of
               --  N_Accept_Alternative, N_Delay_Alternative,
               --  N_Entry_Call_Alternative or N_Triggering_Alternative

               --  forming the first element of the element list to be
               --  returned:

               if Alternative_Node_Kind =  N_Accept_Alternative then
                  First_Element :=
                     Node_To_Element_New (
                        Node             => Accept_Statement (Arg_Node),
                        Internal_Kind    => An_Accept_Statement,
                        Starting_Element => Path);

               elsif Alternative_Node_Kind = N_Delay_Alternative then
                  First_Element :=
                     Node_To_Element_New (
                        Node             => Delay_Statement (Arg_Node),
                        Starting_Element => Path);

               elsif Alternative_Node_Kind = N_Entry_Call_Alternative then
                  First_Element :=
                     Node_To_Element_New (
                        Node             => Entry_Call_Statement (Arg_Node),
                        Internal_Kind    => An_Entry_Call_Statement,
                        Starting_Element => Path);

               elsif Alternative_Node_Kind = N_Triggering_Alternative then
                  First_Element :=
                     Node_To_Element_New (
                        Node             => Triggering_Statement (Arg_Node),
                        Starting_Element => Path);
               end if;

               --  the rest of the returned list:

               Statement_List := Sinfo.Statements (Arg_Node);

               return Asis.Statement_List'(1      => First_Element) &
                      Node_To_Element_List (List           => Statement_List,
                                            In_Unit        => Encl_Unit (Path),
                                            To_Be_Included => Incl_Cond);
            end if;
         when others =>
               null;  -- see condition for defining the appropriate element
      end case;

      return Node_To_Element_List (List           => Result_List,
                                        In_Unit        => Encl_Unit (Path),
                                        To_Be_Included => Incl_Cond);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Path,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Sequence_Of_Statements");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Path,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Sequence_Of_Statements");
   end Sequence_Of_Statements;
-----------------------------------------------------------------------------

   function Case_Expression (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Case_Expression");

      if not (Arg_Kind = A_Case_Statement) then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.Case_Expression");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New
               (Node             => Sinfo.Expression (Arg_Node),
                Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Case_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Case_Expression");
   end Case_Expression;
-----------------------------------------------------------------------------

   function Case_Statement_Alternative_Choices (Path : in Asis.Path)
      return Asis.Element_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Path);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Path,
                "Asis.Statements.Case_Statement_Alternative_Choices");

      if not (Arg_Kind = A_Case_Path) then
         Raise_ASIS_Inappropriate_Element (Diagnosis =>
                "Asis.Statements.Case_Statement_Alternative_Choices");
      end if;

      Arg_Node := Node (Path);

      return Discrete_Choice_Node_To_Element_List (
               Choice_List => Discrete_Choices (Arg_Node),
               In_Unit     => Encl_Unit (Path));
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Path,
            Outer_Call =>
               "Asis.Statements.Case_Statement_Alternative_Choices");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Path,
            Diagnosis => "Asis.Statements.Case_Statement_Alternative_Choices");
   end Case_Statement_Alternative_Choices;
------------------------------------------------------------------------------

   function Statement_Identifier (Statement : in Asis.Statement)
      return Asis.Defining_Name
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement,
                     "Asis.Statements.Loop_Statement_Identifier");

      if not (Arg_Kind = A_Loop_Statement
            or Arg_Kind = A_While_Loop_Statement
            or Arg_Kind = A_For_Loop_Statement
            or Arg_Kind = A_Block_Statement)
      then
            Raise_ASIS_Inappropriate_Element (Diagnosis =>
                  "Asis_Statement.Statement_Identifier");
      end if;

      Arg_Node := Node (Statement);

      if Special_Case (Statement) = A_Dummy_Block_Statement or else
         Has_Created_Identifier (Arg_Node)
      then
         return Nil_Element;
      else
         return Node_To_Element_New (
                        Node             => Sinfo.Identifier (Arg_Node),
                        Internal_Kind    => A_Defining_Identifier,
                        Starting_Element => Statement);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Statement,
            Outer_Call => "Asis.Statements.Statement_Identifier");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Statement_Identifier");
   end Statement_Identifier;
-----------------------------------------------------------------------------
   function Is_Name_Repeated (Statement : in Asis.Statement) return Boolean
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Last_Comp : Asis.Element;
      S         : Source_Ptr;
      Result    : Boolean;
   begin
      Check_Validity (Statement, "Asis.Statements.Is_Name_Repeated");

      if not (Arg_Kind = A_Loop_Statement       or else
              Arg_Kind = A_While_Loop_Statement or else
              Arg_Kind = A_For_Loop_Statement   or else
              Arg_Kind = A_Block_Statement      or else
              Arg_Kind = An_Accept_Statement)
      then
         Result := False;
      end if;

      if Arg_Kind = A_Loop_Statement       or else
         Arg_Kind = A_While_Loop_Statement or else
         Arg_Kind = A_For_Loop_Statement   or else
         Arg_Kind = A_Block_Statement
      then
         Result := not Asis.Elements.Is_Nil (Statement_Identifier (Statement));
      elsif Arg_Kind = An_Accept_Statement then

         if Is_Nil (Accept_Body_Statements (Statement, True)) then
            --  no statements - no "do .. end;" part - no "end"
            --  to repeat the name after
            Result := False;
         else
            Last_Comp := Get_Last_Component (Statement);

            S := Set_Image_End (Last_Comp);
            --  now S points to the last character (it for sure is ';')
            --  of the last component (a statement, an exception
            --  handler or pragma) in the accept statement.
            --  First, we reset S to point onto the first character
            --  after the final end of the accept statement:
            --  the final "end" lexically is an identifier, so:

            S := Next_Identifier (S);
            S := S + 3;
            --  the first character after "end"
            S := Rightmost_Non_Blank (S);
            --  and the final check - what follows the final "end"

            if Get_Character (S) = ';' then
               Result := False;
            else
               Result := True;
            end if;
         end if;
      end if;

      return Result;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Is_Name_Repeated");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Is_Name_Repeated");
   end Is_Name_Repeated;
-----------------------------------------------------------------------------

   function While_Condition (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.While_Condition");

      if not (Arg_Kind = A_While_Loop_Statement) then
         Raise_ASIS_Inappropriate_Element
                     (Diagnosis => "Asis.Statements.While_Condition");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
                Node             => Condition (Iteration_Scheme (Arg_Node)),
                Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.While_Condition");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.While_Condition");
   end While_Condition;
-----------------------------------------------------------------------------

   function For_Loop_Parameter_Specification (Statement : in Asis.Statement)
      return Asis.Declaration
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement,
                     "Asis.Statements.For_Loop_Parameter_Specification");

      if not (Arg_Kind = A_For_Loop_Statement) then
         Raise_ASIS_Inappropriate_Element
          (Diagnosis => "Asis.Statements.For_Loop_Parameter_Specification");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
             Node             => Loop_Parameter_Specification
                                     (Iteration_Scheme (Arg_Node)),
             Internal_Kind    => A_Loop_Parameter_Specification,
             Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.For_Loop_Parameter_Specification");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.For_Loop_Parameter_Specification");
   end For_Loop_Parameter_Specification;
-----------------------------------------------------------------------------

   function Loop_Statements
     (Statement       : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Statement_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Loop_Statements");

      if not (Arg_Kind = A_Loop_Statement       or else
              Arg_Kind = A_While_Loop_Statement or else
              Arg_Kind = A_For_Loop_Statement)
      then
         Raise_ASIS_Inappropriate_Element (Diagnosis =>
                            "Asis_Statement.Loop_Statements");
      end if;

      Arg_Node := Node (Statement);

      if Include_Pragmas then
         return Node_To_Element_List (
              List           => Sinfo.Statements (Arg_Node),
              In_Unit        => Encl_Unit (Statement));
      else
         return Node_To_Element_List (
              List           => Sinfo.Statements (Arg_Node),
              In_Unit        => Encl_Unit (Statement),
              To_Be_Included => No_Pragma'Access);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Loop_Statements");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Loop_Statements");
   end Loop_Statements;
------------------------------------------------------------------------------
   function Is_Declare_Block (Statement : in Asis.Statement) return Boolean
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;

      First_Letter : Character;
      --  the first character of the statement, should be either
      --  B[egin] or D[eclare]

   begin

      --  If the argument represents the dummy block statement created by
      --  the Asis_Declarations.Body_Block_Statement (obsolescent!)
      --  function, the result will be True if and only if the
      --  corresponding body has any declarative item on its own.

      Check_Validity (Statement, "Asis.Statements.Is_Declare_Block");

      if not (Arg_Kind = A_Block_Statement) then
         return False;
      end if;

      Arg_Node := Node (Statement);

      if Special_Case (Statement) = A_Dummy_Block_Statement then
         if Present (Sinfo.Declarations (Arg_Node)) then
            return True;
         else
            return False;
         end if;
      else
         --  a "normal" block statement: here we should be more accurate, and
         --  we cannot rely on "Present (Declarations (Arg_Node))" approach
         --  because of the implicit label declarations

         First_Letter := Source_Text (Get_Source_File_Index (
                  Sloc (Arg_Node)))       -- the unit's text buffer
                   (Sloc (Arg_Node));

         case First_Letter is
            when 'b' | 'B'   =>
               return False;
            when 'd' | 'D'   =>
               return True;
            when others      =>
               Raise_ASIS_Failed (Diagnosis =>
                  "Unexpected beginning of a block statement");
               return False; -- to avoid GNAT warning
         end case;

      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Is_Declare_Block");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Is_Declare_Block");
   end Is_Declare_Block;

------------------------------------------------------------------------------
   function Block_Declarative_Items
     (Statement       : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Declarative_Item_List
   is
      Arg_El   : Asis.Element;
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Block_Declarative_Items");

      if not (Arg_Kind = A_Block_Statement)then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Block_Declarative_Items");
      end if;

      Arg_Node := Node (Statement);

      Arg_El := Statement;

      if Special_Case (Arg_El) = A_Dummy_Block_Statement then
         Set_Special_Case (Arg_El, Not_A_Special_Case);
      end if;

      return N_To_E_List_New
               (List             => Sinfo.Declarations (Arg_Node),
                Include_Pragmas  => Include_Pragmas,
                Starting_Element => Arg_El);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Block_Declarative_Items");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Block_Declarative_Items");
   end Block_Declarative_Items;
-----------------------------------------------------------------------------

   function Block_Statements
     (Statement       : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Statement_List
   is
      Arg_El   : Asis.Element;
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Block_Statements");

      if not (Arg_Kind = A_Block_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Block_Statements");
      end if;

      Arg_Node := Node (Statement);

      Arg_El := Statement;

      if Special_Case (Arg_El) = A_Dummy_Block_Statement then
         Set_Special_Case (Arg_El, Not_A_Special_Case);
      end if;

      return Statements_Node_To_Element_List (
        Statements_Seq   => Handled_Statement_Sequence (Arg_Node),
        Include_Pragmas  => Include_Pragmas,
        Starting_Element => Arg_El);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Block_Statements");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Block_Statements");
   end Block_Statements;
-----------------------------------------------------------------------------

   function Block_Exception_Handlers
     (Statement : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Exception_Handler_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Block_Exception_Handlers");

      if not (Arg_Kind = A_Block_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Block_Exception_Handlers");
      end if;

      Arg_Node := Node (Statement);

      if Special_Case (Statement) = A_Dummy_Block_Statement and then
         No (Handled_Statement_Sequence (Arg_Node))
      then
         --  for the dummy block originated from the package_body_declaration
         --  having no handled_sequence_of_statements on its own.
         return Nil_Element_List;
      end if;

      if Include_Pragmas then
         return N_To_E_List_With_Pragmas
            (List    => Exception_Handlers (
                           Handled_Statement_Sequence (Arg_Node)),
             In_Unit => Encl_Unit (Statement));
      else
         return N_To_E_List_Without_Pragmas
            (List    => Exception_Handlers (
                           Handled_Statement_Sequence (Arg_Node)),
             In_Unit => Encl_Unit (Statement));
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Block_Exception_Handlers");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Block_Exception_Handlers");
   end Block_Exception_Handlers;
-----------------------------------------------------------------------------

   function Exit_Loop_Name (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Exit_Loop_Name");

      if not (Arg_Kind = An_Exit_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Exit_Loop_Name");
      end if;

      Arg_Node := Node (Statement);
      Result_Node := Sinfo.Name (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (Node             => Result_Node,
                                     Starting_Element => Statement);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Exit_Loop_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Exit_Loop_Name");
   end Exit_Loop_Name;
-----------------------------------------------------------------------------

   function Exit_Condition (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Exit_Condition");

      if not (Arg_Kind = An_Exit_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Exit_Loop_Name");
      end if;

      Arg_Node := Node (Statement);
      Result_Node := Condition (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (Node             => Result_Node,
                                     Starting_Element => Statement);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Exit_Condition");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Exit_Condition");
   end Exit_Condition;
------------------------------------------------------------------------------

   function Corresponding_Loop_Exited
     (Statement : in Asis.Statement)
      return Asis.Statement
   is
      Arg_Kind  : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node  : Node_Id;
      Res_Loop  : Node_Id;
      Loop_Name : Node_Id;
   begin
      Check_Validity (Statement,
                     "Asis.Statements.Corresponding_Loop_Exited");

      if not (Arg_Kind = An_Exit_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Corresponding_Loop_Exited");
      end if;

      --  this query can never cross compilation unit boundaries

      Arg_Node  := Node (Statement);
      --  we hope, that the nodes for exist statements are never rewritten
      Loop_Name := Sinfo.Name (Arg_Node);

      if Present (Loop_Name) then
         --  we simply jump to the result loop:
         Loop_Name := Parent (Entity (Loop_Name));
         --  here we are in the implicit declaration of the loop name
         Res_Loop := Label_Construct (Loop_Name);
      else
         --  here we have to traverse the tree up to the furst enclosing
         --  loop statement
         Res_Loop := Parent (Arg_Node);
         while Nkind (Res_Loop) /= N_Loop_Statement loop
            Res_Loop := Parent (Res_Loop);
         end loop;
      end if;

      return Node_To_Element_New (Node             => Res_Loop,
                                  Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Corresponding_Loop_Exited");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Corresponding_Loop_Exited");
   end Corresponding_Loop_Exited;
------------------------------------------------------------------------------

   function Return_Expression (Statement : in Asis.Statement)
       return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Statement,
                     "Asis.Statements.Return_Expression");

      if not (Arg_Kind = A_Return_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Return_Expression");
      end if;

      Arg_Node := Node (Statement);
      Result_Node := Sinfo.Expression (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (Node             => Result_Node,
                                     Starting_Element => Statement);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Return_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Return_Expression");
   end Return_Expression;
-----------------------------------------------------------------------------

   function Goto_Label (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Goto_Label");

      if not (Arg_Kind = A_Goto_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Goto_Label");
      end if;

      Arg_Node := Node (Statement);
      return Node_To_Element_New (Node             => Sinfo.Name (Arg_Node),
                                  Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Goto_Label");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Goto_Label");
   end Goto_Label;
------------------------------------------------------------------------------

   function Corresponding_Destination_Statement
     (Statement : in Asis.Statement)
      return Asis.Statement
   is
      Arg_Kind  : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node  : Node_Id;
      Res_Label : Node_Id;
      Res_Stmt  : Node_Id;
   begin
      Check_Validity (Statement,
                     "Asis.Statements.Corresponding_Destination_Statement");

      if not (Arg_Kind = A_Goto_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Corresponding_Destination_Statement");
      end if;

      --  this semantiic query can never cross compilation units
      --  boundaries
      Arg_Node := Node (Statement);
      --  we hope, that the nodes for goto statements
      --  are never rewritten

      Res_Label := Parent (Entity (Sinfo.Name (Arg_Node)));
      --  this is N_Implicit_Label_Declaration node representing the
      --  implicit declaration of the destination label
      Res_Stmt := Label_Construct (Res_Label);

      while not (Nkind (Res_Stmt) in N_Statement or else
                 Nkind (Res_Stmt) = N_Procedure_Call_Statement)
      loop
         Res_Stmt := Next (Res_Stmt);
      end loop;
      --  if we are in the tree corresponding to a succussful compiler
      --  run, we shall for sure find a statement after any label!

      return Node_To_Element_New (Node             => Res_Stmt,
                                  Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call =>
               "Asis.Statements.Corresponding_Destination_Statement");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis =>
               "Asis.Statements.Corresponding_Destination_Statement");
   end Corresponding_Destination_Statement;
------------------------------------------------------------------------------

   function Called_Name (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;

      --  local variables needed for processing calls to 'Output, 'Read
      --  and 'Write:
      Result_Kind : Internal_Element_Kinds := Not_An_Element;
      Result_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Called_Name");

      if not (Arg_Kind = An_Entry_Call_Statement   or else
              Arg_Kind = A_Procedure_Call_Statement)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Called_Name");
      end if;

      Arg_Node := Node (Statement);

      if Nkind (Arg_Node) =  N_Attribute_Reference then
         --  calls like T'Output (...); T'Read (...) and T'Write (...)
         --  should be processed separately, and the result should
         --  be built on the same node as argument
         Result_Kind := Subprogram_Attribute_Kind (Arg_Node);
         Result_Node := Arg_Node;
      else
         Result_Node := Sinfo.Name (Arg_Node);
      end if;

      return Node_To_Element_New (
                Starting_Element => Statement,
                Node             => Result_Node,
                Internal_Kind    => Result_Kind);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Called_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Called_Name");
   end Called_Name;
-----------------------------------------------------------------------------

   function Corresponding_Called_Entity
     (Statement : in Asis.Statement)
      return Asis.Declaration
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
   begin
      Check_Validity (Statement,
                     "Asis.Statements.Corresponding_Called_Entity");
      if not (Arg_Kind = An_Entry_Call_Statement or else
              Arg_Kind = A_Procedure_Call_Statement)
      then
         Raise_ASIS_Inappropriate_Element (Diagnosis =>
            "Asis.Statements.Corresponding_Called_Entity");
      end if;

      return Get_Corr_Called_Entity (Statement);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Statement,
            Outer_Call => "Asis.Statements.Corresponding_Called_Entity");
         raise;
      when others =>
         Raise_ASIS_Failed (
           Argument  => Statement,
            Diagnosis => "Asis.Statements.Corresponding_Called_Entity");
   end Corresponding_Called_Entity;
------------------------------------------------------------------------------
   function Call_Statement_Parameters
     (Statement  : in Asis.Statement;
      Normalized : in Boolean := False)
      return Asis.Association_List
   is
      Arg_Kind  : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node  : Node_Id;

      Res_Spec_Case : Special_Cases := Not_A_Special_Case;
      Res_Node_List : List_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Call_Statement_Parameters");

      Arg_Node := Node (Statement);

      if   (not (Arg_Kind = An_Entry_Call_Statement  or else
                 Arg_Kind = A_Procedure_Call_Statement))
         or else
           (Normalized and then Nkind (Arg_Node) = N_Attribute_Reference)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Call_Statement_Parameters");
      end if;

      Arg_Node := Node (Statement);

      if Normalized then
         Res_Spec_Case := Is_Normalized;
      end if;

      if Nkind (Arg_Node) = N_Attribute_Reference then
         --  call to 'Output, 'Read or 'Write
         Res_Node_List := Sinfo.Expressions (Arg_Node);
      else
         Res_Node_List := Parameter_Associations (Arg_Node);
      end if;

      return N_To_E_List_Without_Pragmas (
                List          => Res_Node_List,
                Internal_Kind => A_Parameter_Association,
                Special_Case  => Res_Spec_Case,
                In_Unit       => Encl_Unit (Statement));
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Normalized,
            Outer_Call => "Asis.Statements.Call_Statement_Parameters");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Normalized,
            Diagnosis => "Asis.Statements.Call_Statement_Parameters");
   end Call_Statement_Parameters;
-----------------------------------------------------------------------------

   function Accept_Entry_Index (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Accept_Entry_Index");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Accept_Entry_Index");
      end if;

      Arg_Node := Node (Statement);
      Result_Node := Entry_Index (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (Node             => Result_Node,
                                     Starting_Element => Statement);
      end if;

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Accept_Entry_Index");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Accept_Entry_Index");
   end Accept_Entry_Index;
-----------------------------------------------------------------------------

   function Accept_Entry_Direct_Name (Statement : in Asis.Statement)
      return Asis.Name
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Accept_Entry_Direct_Name");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Accept_Entry_Direct_Name");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
               Node             => Entry_Direct_Name (Arg_Node),
               Internal_Kind    => An_Identifier,
               Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Accept_Entry_Direct_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Accept_Entry_Direct_Name");
   end Accept_Entry_Direct_Name;
-----------------------------------------------------------------------------

   function Accept_Parameters
     (Statement : in Asis.Statement)
      return Asis.Parameter_Specification_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Accept_Parameters");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Accept_Parameters");
      end if;

      Arg_Node := Node (Statement);

      return N_To_E_List_New
               (List             => Parameter_Specifications (Arg_Node),
                Starting_Element => Statement,
                Internal_Kind    => A_Parameter_Specification);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Accept_Parameters");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Accept_Parameters");
   end Accept_Parameters;
-----------------------------------------------------------------------------
   function Accept_Body_Statements
     (Statement       : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Statement_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Accept_Body_Statements");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Accept_Body_Statements");
      end if;

      Arg_Node := Node (Statement);

      return Statements_Node_To_Element_List (
        Statements_Seq   => Handled_Statement_Sequence (Arg_Node),
        Include_Pragmas  => Include_Pragmas,
        Starting_Element => Statement);

   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Accept_Body_Statements");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Accept_Body_Statements");
   end Accept_Body_Statements;
-----------------------------------------------------------------------------

   function Accept_Body_Exception_Handlers
     (Statement       : in Asis.Statement;
      Include_Pragmas : in Boolean := False)
      return Asis.Exception_Handler_List
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      St_Seq_Node : Node_Id;
   begin

      Check_Validity (Statement,
                     "Asis.Statements.Accept_Body_Exception_Handlers");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Accept_Body_Exception_Handlers");
      end if;

      Arg_Node := Node (Statement);
      St_Seq_Node := Handled_Statement_Sequence (Arg_Node);

      if No (St_Seq_Node) then
         --  empty body of an accept statement
         return Nil_Element_List;
      elsif Include_Pragmas then
         return N_To_E_List_With_Pragmas
            (List    => Exception_Handlers (St_Seq_Node),
             In_Unit => Encl_Unit (Statement));
      else
         return N_To_E_List_Without_Pragmas
            (List    => Exception_Handlers (St_Seq_Node),
             In_Unit => Encl_Unit (Statement));
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Accept_Body_Exception_Handlers");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Accept_Body_Exception_Handlers");
   end Accept_Body_Exception_Handlers;
-----------------------------------------------------------------------------

   function Corresponding_Entry (Statement : in Asis.Statement)
      return Asis.Declaration
   is
      Arg_Kind      : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node      : Node_Id;
      Res_Entry_Dcl : Node_Id;
   begin
      Check_Validity (Statement, "Asis.Statements.Corresponding_Entry");

      if not (Arg_Kind = An_Accept_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Corresponding_Entry");
      end if;

      Arg_Node      := Node (Statement);
      Res_Entry_Dcl := Parent (Entity (Entry_Direct_Name (Arg_Node)));

      return Node_To_Element_New (Node             => Res_Entry_Dcl,
                                  Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Corresponding_Entry");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Corresponding_Entry");
   end Corresponding_Entry;
-----------------------------------------------------------------------------

   function Requeue_Entry_Name (Statement : in Asis.Statement)
      return Asis.Name
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Requeue_Entry_Name");

      if not (Arg_Kind = A_Requeue_Statement
            or Arg_Kind = A_Requeue_Statement_With_Abort)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Requeue_Entry_Name");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (Node             => Sinfo.Name (Arg_Node),
                                  Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Requeue_Entry_Name");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Requeue_Entry_Name");
   end Requeue_Entry_Name;
-----------------------------------------------------------------------------

   function Delay_Expression (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Delay_Expression");


      if not (Arg_Kind = A_Delay_Until_Statement
            or Arg_Kind = A_Delay_Relative_Statement)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Delay_Expression");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New
               (Node             => Sinfo.Expression (Arg_Node),
                Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Delay_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Delay_Expression");
   end Delay_Expression;
-----------------------------------------------------------------------------

   function Guard (Path : in Asis.Path) return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Path);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Path, "Asis.Statements.Guard");

      if not (Arg_Kind = A_Select_Path or else
              Arg_Kind = An_Or_Path)
      then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Guard");
      end if;

      if not (Nkind (Parent (R_Node (Path))) = N_Selective_Accept) then
         return Nil_Element;
      end if;

      Arg_Node := Node (Path);
      Result_Node := Condition (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else

         return Node_To_Element_New (Node             => Result_Node,
                                     Starting_Element => Path);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Path,
            Outer_Call => "Asis.Statements.Guard");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Path,
            Diagnosis => "Asis.Statements.Guard");
   end Guard;
-----------------------------------------------------------------------------

   function Aborted_Tasks (Statement : in Asis.Statement)
      return Asis.Expression_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Aborted_Tasks");

      if not (Arg_Kind = An_Abort_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Aborted_Tasks");
      end if;

      Arg_Node := Node (Statement);
      return Node_To_Element_List (
            List    => Names (Arg_Node),
            In_Unit => Encl_Unit (Statement));
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Aborted_Tasks");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Aborted_Tasks");
   end Aborted_Tasks;
-----------------------------------------------------------------------------

   function Choice_Parameter_Specification
     (Handler : in Asis.Exception_Handler)
      return Asis.Declaration
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Handler);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Handler,
                     "Asis.Statements.Choice_Parameter_Specification");

      if not (Arg_Kind = An_Exception_Handler) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Choice_Parameter_Specification");
      end if;

      Arg_Node := Node (Handler);
      Result_Node := Choice_Parameter (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (
                  Node             => Result_Node,
                  Internal_Kind    => A_Choice_Parameter_Specification,
                  Starting_Element => Handler);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Handler,
            Outer_Call => "Asis.Statements.Choice_Parameter_Specification");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Handler,
            Diagnosis => "Asis.Statements.Choice_Parameter_Specification");
   end Choice_Parameter_Specification;
-----------------------------------------------------------------------------

   function Exception_Choices (Handler : in Asis.Exception_Handler)
      return Asis.Element_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Handler);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Handler, "Asis.Statements.Exception_Choices");

      if not (Arg_Kind = An_Exception_Handler) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Exception_Choices");
      end if;

      Arg_Node := Node (Handler);

      return Node_To_Element_List (
            List    => Exception_Choices (Arg_Node),
            In_Unit => Encl_Unit (Handler));
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Handler,
            Outer_Call => "Asis.Statements.Exception_Choices");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Handler,
            Diagnosis => "Asis.Statements.Exception_Choices");
   end Exception_Choices;
-----------------------------------------------------------------------------

   function Handler_Statements
     (Handler         : in Asis.Exception_Handler;
      Include_Pragmas : in Boolean := False)
      return Asis.Statement_List
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Handler);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Handler, "Asis.Statements.Handler_Statements");

      if not (Arg_Kind = An_Exception_Handler) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Handler_Statements");
      end if;

      Arg_Node := Node (Handler);

      if Include_Pragmas then
         return Node_To_Element_List (
              List    => Sinfo.Statements (Arg_Node),
              In_Unit => Encl_Unit (Handler));
      else
         return Node_To_Element_List (
              List           => Sinfo.Statements (Arg_Node),
              In_Unit        => Encl_Unit (Handler),
              To_Be_Included => No_Pragma'Access);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Handler,
            Bool_Par  => Include_Pragmas,
            Outer_Call => "Asis.Statements.Handler_Statements");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Handler,
            Bool_Par  => Include_Pragmas,
            Diagnosis => "Asis.Statements.Handler_Statements");
   end Handler_Statements;
-----------------------------------------------------------------------------

   function Raised_Exception (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind    : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node    : Node_Id;
      Result_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Raised_Exception");

      if not (Arg_Kind = A_Raise_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Raised_Exception");
      end if;

      Arg_Node := Node (Statement);
      Result_Node := Sinfo.Name (Arg_Node);

      if No (Result_Node) then
         return Nil_Element;
      else
         return Node_To_Element_New (
                  Node             => Result_Node,
                  Starting_Element => Statement);
      end if;
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Raised_Exception");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Raised_Exception");
   end Raised_Exception;
-----------------------------------------------------------------------------

   function Qualified_Expression (Statement : in Asis.Statement)
      return Asis.Expression
   is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Statement);
      Arg_Node : Node_Id;
   begin

      Check_Validity (Statement, "Asis.Statements.Qualified_Expression");

      if not (Arg_Kind = A_Code_Statement) then
         Raise_ASIS_Inappropriate_Element
               ("Asis.Statements.Raised_Exception");
      end if;

      Arg_Node := Node (Statement);

      return Node_To_Element_New (
               Node             => Sinfo.Expression (Arg_Node),
               Internal_Kind    => A_Qualified_Expression,
               Starting_Element => Statement);
   exception
      when ASIS_Inappropriate_Element =>
         raise;
      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Statement,
            Outer_Call => "Asis.Statements.Qualified_Expression");
         raise;
      when others =>
         Raise_ASIS_Failed (
            Argument  => Statement,
            Diagnosis => "Asis.Statements.Qualified_Expression");
   end Qualified_Expression;
------------------------------------------------------------------------------

   -------------------------
   -- Is_Dispatching_Call --
   -------------------------

   function Is_Dispatching_Call (Call : in Asis.Element) return Boolean is
      Arg_Kind : Internal_Element_Kinds := Int_Kind (Call);
      Arg_Node : Node_Id;
   begin

      if not (Arg_Kind = A_Function_Call or else
              Arg_Kind = A_Procedure_Call_Statement)
      then
         return False;
      end if;

      Arg_Node := Node (Call);

      if not (Nkind (Arg_Node) = N_Function_Call or else
              Nkind (Arg_Node) = N_Procedure_Call_Statement)
      then
         --  this may be possible as a result of tree rewritting, but if we
         --  have rewritting, we do not have a dispatching call, so:
         return False;
      else
         return Present (Controlling_Argument (Arg_Node));
      end if;

   exception

      when ASIS_Failed =>
         Add_Call_Information (
            Argument  => Call,
            Outer_Call => "Asis.Statements.Is_Dispatching_Call");
         raise;

      when others =>
         Raise_ASIS_Failed (
            Argument  => Call,
            Diagnosis => "Asis.Statements.Is_Dispatching_Call");

   end Is_Dispatching_Call;

   --------------------------------------
   -- Is_Call_On_Dispatching_Operation --
   --------------------------------------

   function Is_Call_On_Dispatching_Operation
     (Call : in Asis.Element)
      return Boolean
   is
      Arg_Kind         : Internal_Element_Kinds := Int_Kind (Call);
      Called_Entity    : Asis.Element;
      Owning_Type      : Asis.Element;
      Owning_Type_Kind : Internal_Element_Kinds;
   begin
      --  Just the first version, should be tested more carefully!
      --  Is currently implemented as a secondary query based on
      --  some queries from Asis.Extensions.
      --  ??? !!!
      --  Still depends on partially implemented queries from
      --  Asis.Extensions

      if not (Arg_Kind = A_Function_Call or else
              Arg_Kind = A_Procedure_Call_Statement)
      then
         return False;
      end if;

      if Arg_Kind = A_Function_Call then
         Called_Entity := Corresponding_Called_Function (Call);
      else
         Called_Entity := Corresponding_Called_Entity (Call);
      end if;

      if Is_Nil (Called_Entity) or else
         (not Is_Primitive_Operation (Called_Entity))
      then
         return False;
      end if;

      Owning_Type      := Primary_Owner (Called_Entity);
      Owning_Type      := Type_Declaration_View (Owning_Type);

      Owning_Type_Kind := Int_Kind (Owning_Type);

      return
        (Owning_Type_Kind = A_Tagged_Private_Type_Definition      or else
         Owning_Type_Kind = A_Private_Extension_Definition        or else
         Owning_Type_Kind = A_Derived_Record_Extension_Definition or else
         Owning_Type_Kind = A_Tagged_Record_Type_Definition);

   exception

      when ASIS_Failed =>
         Add_Call_Information (
            Argument   => Call,
            Outer_Call => "Asis.Statements.Is_Call_On_Dispatching_Operation");
         raise;

      when others =>
         Raise_ASIS_Failed (
            Argument  => Call,
            Diagnosis => "Asis.Statements.Is_Call_On_Dispatching_Operation");

   end Is_Call_On_Dispatching_Operation;

end Asis.Statements