------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                G N A T P P . A S I S _ U T I L I T I E S                 --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2007, AdaCore                      --
--                                                                          --
-- GNATPP is free software; you can redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNATPP is  distributed in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY or  FITNESS  FOR A  PARTICULAR  PURPOSE. See the GNU General Public --
-- License  for more details. You  should  have  received a copy of the GNU --
-- General Public License  distributed with GNAT; see file COPYING. If not, --
-- write to the Free Software Foundation,  51 Franklin Street, Fifth Floor, --
-- Boston,                                                                  --
--                                                                          --
-- GNATPP is maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Table;

with Asis.Exceptions;                 use Asis.Exceptions;
with Asis.Compilation_Units;          use Asis.Compilation_Units;
with Asis.Elements;                   use Asis.Elements;
with Asis.Declarations;               use Asis.Declarations;
with Asis.Definitions;                use Asis.Definitions;
with Asis.Statements;                 use Asis.Statements;
with Asis.Expressions;                use Asis.Expressions;
with Asis.Text;                       use Asis.Text;

with ASIS_UL.Options;

with GNATPP.Options;                  use GNATPP.Options;
with GNATPP.General_Traversal_Stacks; use GNATPP.General_Traversal_Stacks;

package body GNATPP.Asis_Utilities is

   package Var_String is new Table.Table
     (Table_Component_Type => Wide_Character,
      Table_Index_Type     => Natural,
      Table_Low_Bound      => 1,
      Table_Initial        => 100,
      Table_Increment      => 100,
      Table_Name           => "");

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Detect_Possible_Layout_From_Text
     (The_Image       : Program_Text;
      Space_In_Output : out Positive;
      Comment_Inside  : out Boolean);
   --  ???

   ----------------------
   -- Adds_Indentation --
   ----------------------

   function Adds_Indentation (El : Flat_Element_Kinds) return Boolean is
      Result : Boolean := False;
   begin

      case El is
         when A_Task_Type_Declaration         |
              A_Protected_Type_Declaration    |
              A_Single_Task_Declaration       |
              A_Single_Protected_Declaration  |
              A_Procedure_Declaration         |
              A_Function_Declaration          |
              A_Procedure_Body_Declaration    |
              A_Function_Body_Declaration     |
              A_Package_Declaration           |
              A_Package_Body_Declaration      |
              A_Task_Body_Declaration         |
              A_Protected_Body_Declaration    |
              An_Entry_Declaration            |
              An_Entry_Body_Declaration       |
              A_Generic_Procedure_Declaration |
              A_Generic_Function_Declaration  |
              A_Generic_Package_Declaration   |
              A_Loop_Statement                |
              A_While_Loop_Statement          |
              A_For_Loop_Statement            |
              A_Block_Statement               =>

            Result := True;

         when others =>
            null;
      end case;

      return Result;
   end Adds_Indentation;

   --------------------------
   -- Are_Of_Same_Priority --
   --------------------------

   function Are_Of_Same_Priority
     (Op1, Op2 : Flat_Element_Kinds)
      return     Boolean
   is
      Result : Boolean := False;
   begin

      if Op1 in Flat_Operator_Symbol_Kinds and then
         Op2 in Flat_Operator_Symbol_Kinds
      then

         if Op1 = Op2 then
            Result := True;
         elsif Op1 in A_Plus_Operator .. A_Concatenate_Operator then
            Result := Op2 in A_Plus_Operator .. A_Concatenate_Operator;
         end if;

      end if;

      return Result;
   end Are_Of_Same_Priority;

   --------------------
   -- Can_Be_Aligned --
   --------------------

   function Can_Be_Aligned (El : Element) return Boolean is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
      Result   : Boolean                     := False;
   begin

      --  Not all the possible constructs are considered as Can_Be_Aligned
      --  here. For example, for record components alignment is processed in
      --  a special way. This test function is supposed to be used in a
      --  "paragraph"

      case Arg_Kind is
         when A_Variable_Declaration          |
              A_Constant_Declaration          |
              A_Deferred_Constant_Declaration |
              An_Integer_Number_Declaration   |
              A_Real_Number_Declaration       |
              An_Object_Renaming_Declaration  |
              A_Component_Declaration         |
              A_Discriminant_Specification    =>

            if Align_Colons_In_Decl then
               Result := True;
            end if;

         when An_Assignment_Statement =>

            if Align_Asign_In_Stmts then
               Result := True;
            end if;

         when A_Component_Clause =>

            if Allign_Ats then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Can_Be_Aligned;

   ---------------------------
   -- Contains_Declarations --
   ---------------------------

   function Contains_Declarations
     (El_Kind : Flat_Element_Kinds)
      return    Boolean
   is
      Result : Boolean := False;
   begin

      case El_Kind is

         when A_Procedure_Body_Declaration  |
              A_Function_Body_Declaration   |
              A_Package_Body_Declaration    |
              A_Task_Body_Declaration       |
              An_Entry_Body_Declaration     |
              A_Package_Declaration         |
              A_Generic_Package_Declaration |
              A_Block_Statement             |
              A_Record_Definition           |
              A_Protected_Definition        |
              A_Variant                     |
              A_Known_Discriminant_Part     =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Contains_Declarations;

   -------------------------
   -- Contains_Statements --
   -------------------------

   function Contains_Statements
     (El_Kind : Flat_Element_Kinds)
      return    Boolean
   is
      Result : Boolean := False;
   begin
      case El_Kind is

         when A_Procedure_Body_Declaration |
              A_Function_Body_Declaration  |
              A_Package_Body_Declaration   |
              A_Task_Body_Declaration      |
              An_Entry_Body_Declaration    |
              A_Block_Statement            |
              Flat_Path_Kinds              |
              Flat_Loop_Statement          |
              An_Extended_Return_Statement |
              An_Accept_Statement          |
              An_Exception_Handler         =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Contains_Statements;

   --------------------------------------
   -- Declaration_Starts_From_Def_Name --
   --------------------------------------

   function Declaration_Starts_From_Def_Name
     (El :   Flat_Element_Kinds)
      return Boolean
   is
      Result : Boolean := False;
   begin

      case El is
         when A_Variable_Declaration            |
              A_Constant_Declaration            |
              A_Deferred_Constant_Declaration   |
              An_Integer_Number_Declaration     |
              A_Real_Number_Declaration         |
              A_Discriminant_Specification      |
              A_Component_Declaration           |
              A_Parameter_Specification         |
              An_Object_Renaming_Declaration    |
              An_Exception_Renaming_Declaration |
              An_Exception_Declaration          |
              A_Formal_Object_Declaration       |
              A_Loop_Statement                  |
              A_While_Loop_Statement            |
              A_For_Loop_Statement              |
              A_Block_Statement                 |
              A_Defining_Expanded_Name          =>

            Result := True;

         when others =>
            null;
      end case;

      return Result;
   end Declaration_Starts_From_Def_Name;

   --------------
   -- Def_Name --
   --------------

   function Def_Name (Declaration_Element : Element) return Element is
   begin
      return Names (Declaration_Element) (1);
   end Def_Name;

   ----------------------------
   -- Detect_Possible_Layout --
   ----------------------------

   procedure Detect_Possible_Layout
     (The_Element     : Element;
      Space_In_Output : out Natural;
      Comment_Inside  : out Boolean)
   is
   begin

      if Is_Nil (The_Element) then
         Space_In_Output := 0;
         Comment_Inside  := False;
         return;
      end if;

      declare
         The_Image : constant Program_Text := Element_Image (The_Element);
      begin
         Detect_Possible_Layout_From_Text
           (The_Image       => The_Image,
            Space_In_Output => Space_In_Output,
            Comment_Inside  => Comment_Inside);
      end;

   end Detect_Possible_Layout;

   --------------------------------------
   -- Detect_Possible_Layout_From_Text --
   --------------------------------------

   procedure Detect_Possible_Layout_From_Text
     (The_Image       : Program_Text;
      Space_In_Output : out Positive;
      Comment_Inside  : out Boolean)
   is
      Idx            : Natural;
      Image_First    : Positive          := The_Image'First;
      Image_Last     : constant Positive := The_Image'Last;
      Quotation_Char : Wide_Character;
      Was_Identifier : Boolean;

      Expect_NS_Replacement : Boolean := False;
      --  Us used by Is_Number_Sign_Replacement to detect the *second* ':'
      --  which is the replacement of '#' in based literal. When
      --  Is_Number_Sign_Replacement passes the first replacement (which is
      --  easy to detect because it has digit on its left and extended digit
      --  on its right, Is_Number_Sign_Replacement sets in ON, when it passes
      --  the second one - sets it back OFF.

      procedure Skip_Spaces;
      --  Starting from the current value of Idx, resets it pointing to the
      --  next not-white-space character. If there is no non-blank characters
      --  any more, sets Idx to Image_Last + 1

      function Is_Char_Literal return Boolean;
      --  Checks if Idx points to ' which is the left ' in a character literal
      --  (we assume that we are NOT inside a string literal or a comment. We
      --  also assume that Idx already points to ')

      function Is_Number_Sign_Replacement return Boolean;
      --  Checks if Idx points to ':' which is a replacement of '#"

      function Is_Char_Literal return Boolean is
         Result : Boolean := False;

         Word_Start : Natural := 0;
         Word_End   : Natural := 0;
         --  The beginning and the end of the word preceding Idx
      begin

         if Idx + 2 <= Image_Last
          and then
            The_Image (Idx + 2) = '''
         then

            Result := True;

            --  Check that the non-space character preceding Idx is not an
            --  identifier except it is the name of a predefined operation
            --  which can be used in infix form, such as 'and'

            for J in reverse Image_First .. Idx - 1 loop

               if The_Image (Idx) /= ' '
                 and then
                  The_Image (Idx) /=
                     Wide_Character'Val (Character'Pos (ASCII.CR))
                 and then
                  The_Image (Idx) /=
                     Wide_Character'Val (Character'Pos (ASCII.LF))
                 and then
                  The_Image (Idx) /=
                    Wide_Character'Val (Character'Pos (ASCII.HT))
               then
                  Word_End := J;
                  exit;
               end if;

            end loop;

            if Word_End /= 0
             and then
               Is_Letter (To_Character (The_Image (Word_End)))
            then
               --  We may have the qualified expression like Some_Type'('a')

               Result     := False;
               Word_Start := Word_End;

               for J in reverse Image_First .. Word_End - 1 loop
                  if not (Is_Alphanumeric (To_Character (The_Image (J)))
                   or else
                          The_Image (J) = '_')
                  then
                     Word_Start := J + 1;
                     exit;
                  end if;

               end loop;

               if Word_End - Word_Start + 1 = 2
                 or else
                  Word_End - Word_Start + 1 = 3
               then

                  declare
                     Word : constant String :=
                       To_Lower
                         (To_String (The_Image (Word_Start .. Word_End)));
                  begin

                     if Word = "and"
                       or else
                        Word = "abs"
                       or else
                        Word = "not"
                       or else
                        Word = "xor"
                       or else
                        Word = "and"
                       or else
                        Word = "or"
                     then
                        Result := True;
                     end if;

                  end;

               end if;

            end if;

         end if;

         return Result;

      end Is_Char_Literal;

      function Is_Number_Sign_Replacement return Boolean is
         Result : Boolean := False;
      begin

         if The_Image (Idx) = ':' then

            if Expect_NS_Replacement then
               Expect_NS_Replacement := False;
               Result                := True;
            elsif True
              and then Idx > Image_First
              and then Idx < Image_Last
              and then The_Image (Idx - 1) in '0' .. '9'
              and then (The_Image (Idx + 1) in '0' .. '9' or else
                        The_Image (Idx + 1) in 'A' .. 'F')
            then
               Expect_NS_Replacement := True;
               Result                := True;
            end if;

         end if;

         return Result;
      end Is_Number_Sign_Replacement;

      procedure Skip_Spaces is
      begin

         while Idx <= Image_Last loop

            case The_Image (Idx) is

               when ' '                                         |
                  Wide_Character'Val (Character'Pos (ASCII.CR)) |
                  Wide_Character'Val (Character'Pos (ASCII.LF)) |
                  Wide_Character'Val (Character'Pos (ASCII.HT)) =>

                  Idx := Idx + 1;

               when others =>
                  exit;
            end case;

         end loop;

      end Skip_Spaces;

   begin

      --  The idea of the implementation is to traverse the image of the
      --  argument Element and to "normalize" by skipping the line breaks and
      --  using spaces as separators in accordance with pretty-printing rules.
      --  This normalization stops as soon as one of the following conditions
      --  is satisfied:
      --  - the Element image is over;
      --  - the length of the normalized image exceeds Max_Line_Length;
      --  - the comment being a part of the element image is found

      Comment_Inside := False;
      Var_String.Init;

      --  The_Image is supposed to be the image of some element, so it can not
      --  start from white space ???

      while The_Image (Image_First) = ' ' or else
            The_Image (Image_First) = To_Wide_Character (ASCII.HT)
      loop
         Image_First := Image_First + 1;
      end loop;

      Idx := Image_First;

      while Idx <= Image_Last and then Var_String.Last <= Max_Line_Length
      loop

         case The_Image (Idx) is

            when '"' | '%' =>

               Quotation_Char := The_Image (Idx);

               Var_String.Append (The_Image (Idx));
               Idx := Idx + 1;

               if The_Image (Idx) = Quotation_Char and then
                  (Idx = Image_Last or else
                   The_Image (Idx + 1) /= Quotation_Char)
               then
                  --  Empty string
                  Var_String.Append (The_Image (Idx));
                  Idx := Idx + 1;

               else

                  while not (The_Image (Idx) = Quotation_Char and then
                           (Idx = Image_Last or else
                            The_Image (Idx + 1) /= Quotation_Char))
                  loop
                     if The_Image (Idx) = Quotation_Char then
                        --  the first part of the doubled quotation char being
                        --  the part of the string
                        Var_String.Append (The_Image (Idx));
                        Idx := Idx + 1;
                     end if;

                     Var_String.Append (The_Image (Idx));
                     Idx := Idx + 1;

                  end loop;

                  Var_String.Append (The_Image (Idx));

               end if;

            when ''' =>

               Var_String.Append (''');

--               if The_Image (Idx + 2) = ''' then

               if Is_Char_Literal then

                  --  a character literal
                  Var_String.Append (The_Image (Idx + 1));
                  Var_String.Append (''');
                  Idx := Idx + 2;
               end if;

            when '&' |
                 '+' |
                 '-' |
                 '/' |
                 ':' |
                 '<' |
                 '=' |
                 '>' |
                 '|' |
                 '!' |
                 '*' =>

               --  We just think, that any delimiter starting from these
               --  symbols should always be surrounded by one space from each
               --  side. This is not true for unary '+' and '-', but we think
               --  there is no harm to set extra space here when computing
               --  the space needed in the output line

               if The_Image (Idx) = '-' and then
                  Idx < Image_Last and then
                  The_Image (Idx + 1) = '-'
               then
                  Comment_Inside := True;
                  exit;
               end if;

               if Is_Number_Sign_Replacement then
                  Var_String.Append (The_Image (Idx));
               else
                  Var_String.Append (' ');
                  Var_String.Append (The_Image (Idx));

                  case The_Image (Idx + 1) is
                     when '=' |
                          '<' |
                          '>' |
                          '*' =>

                        Idx := Idx + 1;
                        Var_String.Append (The_Image (Idx));

                     when others =>
                        null;
                  end case;

                  Var_String.Append (' ');
               end if;

            when '.' =>

               if The_Image (Idx + 1) = '.' then
                  Var_String.Append (' ');
                  Var_String.Append (The_Image (Idx));
                  Idx := Idx + 1;
                  Var_String.Append (The_Image (Idx));
                  Var_String.Append (' ');
               else
                  Var_String.Append (The_Image (Idx));
               end if;

            when ',' |
                 ';' =>
               Var_String.Append (The_Image (Idx));
               Var_String.Append (' ');

            when '(' =>

               if Idx > Image_First then
                  Var_String.Append (' ');
               end if;

               Var_String.Append (The_Image (Idx));

            when ')' =>
               Var_String.Append (The_Image (Idx));

               if Idx < Image_Last and then
                  The_Image (Idx + 1) /= '.'
               then
                  Var_String.Append (' ');
               end if;

            when ' '                                           |
                 Wide_Character'Val (Character'Pos (ASCII.CR)) |
                 Wide_Character'Val (Character'Pos (ASCII.LF)) |
                 Wide_Character'Val (Character'Pos (ASCII.HT))  =>
               --  all the white spaces in the original image are skipped
               --  except those of them which separate identifiers an/or
               --  keywords (e.g. 'for J in' or 'array of'

               if Idx > Image_First and then
                  Is_Alphanumeric (To_Character (The_Image (Idx - 1)))
               then
                  Was_Identifier := True;
               else
                  Was_Identifier := False;
               end if;

               Skip_Spaces;

               if Idx <= Image_Last then

                  if Was_Identifier and then
                     Is_Alphanumeric (To_Character (The_Image (Idx)))
                  then
                     Var_String.Append (' ');
                  end if;

                  Idx := Idx - 1;

               end if;

            when others =>
               Var_String.Append (The_Image (Idx));
         end case;

         Idx := Idx + 1;

      end loop;

      Space_In_Output := Var_String.Last;

   end Detect_Possible_Layout_From_Text;

   -------------------
   -- First_Operand --
   -------------------

   function First_Operand (El : Element) return Element is
      Op      : Flat_Element_Kinds;
      Next_Op : Flat_Element_Kinds;
      Result  : Element;

      function Get_Op (E : Element) return Flat_Element_Kinds;
      --  Provided that E is a function call or a short circuit form, returns
      --  the kind of the operation sign (for short circuit, the corresponding
      --  short circuit expression kind is returned. If E is not an infix call
      --  of a binary operation or a short circuit form, Not_An_Element is
      --  returned

      function Get_First_Operand (E : Element) return Element;
      --  returns the first parameter of the argument, provided that it is
      --  an infix call of a binary operation or a short circuit form

      function Get_Op (E : Element) return Flat_Element_Kinds is
         Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (E);
         Result   : Flat_Element_Kinds  := Not_An_Element;
      begin

         case Arg_Kind is
            when A_Function_Call =>

               if not Is_Prefix_Call (E) then
                  Result := Flat_Element_Kind (Prefix (E));

                  case Result is
                     when A_Unary_Plus_Operator  |
                          A_Unary_Minus_Operator =>
                        Result := Not_An_Element;
                     when others =>
                        null;
                  end case;

               end if;

            when An_And_Then_Short_Circuit ..
                 A_Not_In_Type_Membership_Test =>

               Result := Arg_Kind;
            when others =>
               null;
         end case;

         return Result;
      end Get_Op;

      function Get_First_Operand (E : Element) return Element is
         Result : Element;
      begin

         if Flat_Element_Kind (E) = An_And_Then_Short_Circuit or else
            Flat_Element_Kind (E) = An_Or_Else_Short_Circuit
         then
            Result := Short_Circuit_Operation_Left_Expression (E);

         elsif Flat_Element_Kind (E) in An_In_Range_Membership_Test ..
                                        A_Not_In_Type_Membership_Test
         then
            Result := Membership_Test_Expression (E);

         else
            Result := Function_Call_Parameters (E) (1);
            Result := Actual_Parameter (Result);
         end if;

         return Result;
      end Get_First_Operand;

   begin
      Op      := Get_Op (El);
      Result  := Get_First_Operand (El);
      Next_Op := Get_Op (Result);

      while Are_Of_Same_Priority (Op, Next_Op) or else
            Op = Next_Op --  Is needed for short circuits
      loop
         Result  := Get_First_Operand (Result);
         Next_Op := Get_Op (Result);
      end loop;

      return Result;
   end First_Operand;

   -------------------
   -- Get_First_Par --
   -------------------

   function Get_First_Par (El : Element) return Element is
      Result : Element := Nil_Element;
   begin

      if Expression_Kind (El) = A_Function_Call then
         Result := Actual_Parameter (Function_Call_Parameters (El) (1));
      elsif Statement_Kind (El) = A_Procedure_Call_Statement then
         Result := Actual_Parameter (Call_Statement_Parameters (El) (1));
      end if;

      return Result;
   end Get_First_Par;

   -----------------
   -- Has_Choices --
   -----------------

   function Has_Choices (El_Kind : Flat_Element_Kinds) return Boolean is
   begin

      return False
         or else El_Kind = A_Case_Path
         or else El_Kind = An_Exception_Handler
         or else El_Kind = A_Variant
         or else El_Kind = A_Record_Component_Association
         or else El_Kind = An_Array_Component_Association;
   end Has_Choices;

   --------------------
   -- Has_Parameters --
   --------------------

   function Has_Parameters (El_Kind : Flat_Element_Kinds) return Boolean is
   begin

      return (False
        or else El_Kind = A_Procedure_Declaration
        or else El_Kind = A_Null_Procedure_Declaration
        or else El_Kind = A_Function_Declaration
        or else El_Kind = A_Procedure_Body_Declaration
        or else El_Kind = A_Function_Body_Declaration
        or else El_Kind = A_Procedure_Renaming_Declaration
        or else El_Kind = A_Function_Renaming_Declaration
        or else El_Kind = An_Entry_Declaration
        or else El_Kind = An_Entry_Body_Declaration
        or else El_Kind = A_Procedure_Body_Stub
        or else El_Kind = A_Function_Body_Stub
        or else El_Kind = A_Generic_Function_Declaration
        or else El_Kind = A_Generic_Procedure_Declaration
        or else El_Kind = A_Formal_Function_Declaration
        or else El_Kind = A_Formal_Procedure_Declaration
        or else El_Kind = An_Accept_Statement
        or else El_Kind = An_Access_To_Procedure
        or else El_Kind = An_Access_To_Protected_Procedure
        or else El_Kind = An_Access_To_Function
        or else El_Kind = An_Access_To_Protected_Function
        or else El_Kind = An_Anonymous_Access_To_Procedure
        or else El_Kind = An_Anonymous_Access_To_Protected_Procedure
        or else El_Kind = An_Anonymous_Access_To_Function
        or else El_Kind = An_Anonymous_Access_To_Protected_Function
        or else El_Kind = A_Formal_Access_To_Procedure
        or else El_Kind = A_Formal_Access_To_Protected_Procedure
        or else El_Kind = A_Formal_Access_To_Function
        or else El_Kind = A_Formal_Access_To_Protected_Function);

   end Has_Parameters;

   -------------------------
   -- In_Return_Statement --
   -------------------------

   function In_Return_Statement
     (El :   Element)
      return Boolean
   is
      pragma Unreferenced (El);
      Result : Boolean := False;

      Steps_Down : Natural := 0;
      Tmp        : Element := Traversal_Stack.Top (Steps_Down).The_Element;
   begin

      --  The imnplementation uses
      --  GNATPP.General_Traversal_Stacks.Traversal_Stack.Top instead of
      --  Asis.Elements.Enclosing_Element because of the performance reasons.

      while Flat_Element_Kind (Tmp) in Flat_Expression_Kinds or else
            Flat_Element_Kind (Tmp) = A_Parameter_Association
      loop
         Steps_Down := Steps_Down + 1;
         Tmp := Traversal_Stack.Top (Steps_Down).The_Element;
      end loop;

      if Flat_Element_Kind (Tmp) = A_Return_Statement then
         Result := True;
      end if;

      return Result;

   end In_Return_Statement;

   ---------------------------------------
   -- In_Unconstrained_Array_Definition --
   ---------------------------------------

   function In_Unconstrained_Array_Definition
     (El :   Element)
      return Boolean
   is
      pragma Unreferenced (El);
      Result : Boolean := False;

      Steps_Down : Natural := 0;
      Tmp        : Element := Traversal_Stack.Top (Steps_Down).The_Element;
   begin

      --  The imnplementation uses
      --  GNATPP.General_Traversal_Stacks.Traversal_Stack.Top instead of
      --  Asis.Elements.Enclosing_Element because of the performance reasons.

      while Flat_Element_Kind (Tmp) in Flat_Expression_Kinds loop
         Steps_Down := Steps_Down + 1;
         Tmp := Traversal_Stack.Top (Steps_Down).The_Element;
      end loop;

      if Flat_Element_Kind (Tmp) = An_Unconstrained_Array_Definition then
         Result := True;
      end if;

      return Result;

   end In_Unconstrained_Array_Definition;

   -------------------------
   -- Is_Array_Definition --
   -------------------------

   function Is_Array_Definition
     (El_Kind : Flat_Element_Kinds)
      return    Boolean
   is
   begin
      return False
         or else El_Kind = An_Unconstrained_Array_Definition
         or else El_Kind = A_Constrained_Array_Definition
         or else El_Kind = A_Formal_Unconstrained_Array_Definition
         or else El_Kind = A_Formal_Constrained_Array_Definition;
   end Is_Array_Definition;

   ------------------------------
   -- Is_Assignment_Expression --
   ------------------------------

   function Is_Assignment_Expression (El : Element) return Boolean is
      Encl_El : constant Element := Traversal_Stack.Top.The_Element;
      Result  : Boolean          := False;
   begin
      --  The imnplementation uses
      --  GNATPP.General_Traversal_Stacks.Traversal_Stack.Top instead of
      --  Asis.Elements.Enclosing_Element because of the performance reasons.

      case Flat_Element_Kind (Encl_El) is
         when An_Assignment_Statement =>

            if Is_Equal (El, Assignment_Expression (Encl_El)) then
               Result := True;
            end if;

         when A_Variable_Declaration        |
              A_Constant_Declaration        |
              An_Integer_Number_Declaration |
              A_Real_Number_Declaration     |
              A_Discriminant_Specification  |
              A_Component_Declaration       |
              A_Parameter_Specification     |
              A_Formal_Object_Declaration   =>

            if Is_Equal (El, Initialization_Expression (Encl_El)) then
               Result := True;
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Is_Assignment_Expression;

   -------------
   -- Is_Call --
   -------------

   function Is_Call (El : Element) return Boolean is
      El_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
   begin

      return (False
         or else El_Kind = An_Entry_Call_Statement
         or else El_Kind = A_Procedure_Call_Statement
         or else El_Kind = A_Function_Call
         or else El_Kind = An_And_Then_Short_Circuit
         or else El_Kind = An_Or_Else_Short_Circuit
         or else El_Kind in Flat_Pragma_Kinds);

   end Is_Call;

   --------------------------
   -- Is_First_Association --
   --------------------------

   function Is_First_Association (El : Element) return Boolean is
      Result : Boolean := False;

      El_EE          : Element;
      EE_Kind        : Flat_Element_Kinds;
      Idx_To_Compare : Positive := 1;

      function Enclosing_List return Element_List;
      --  Assuming that El is an association element, returns the association
      --  list El belongs to

      function Enclosing_List return Element_List is
      begin

         case EE_Kind is
            when Flat_Pragma_Kinds =>
               return Pragma_Argument_Associations (El_EE);

            when A_Discriminant_Constraint =>
               return Discriminant_Associations (El_EE);

            when A_Record_Aggregate     |
                 An_Extension_Aggregate =>
               return Record_Component_Associations (El_EE);

            when An_Entry_Call_Statement    |
                 A_Procedure_Call_Statement =>
               return Call_Statement_Parameters (El_EE);

            when A_Function_Call =>
               return Function_Call_Parameters (El_EE);

            when A_Function_Instantiation     |
                 A_Package_Instantiation      |
                 A_Procedure_Instantiation    |
                 A_Formal_Package_Declaration =>
               return Generic_Actual_Part (El_EE);

            when others =>
               return Nil_Element_List;
         end case;

      end Enclosing_List;

   begin

      --  The imnplementation uses
      --  GNATPP.General_Traversal_Stacks.Traversal_Stack.Top instead of
      --  Asis.Elements.Enclosing_Element because of the performance reasons.

      if Flat_Element_Kind (El) in Flat_Association_Kinds then
         El_EE   := Traversal_Stack.Top.The_Element;
         EE_Kind := Flat_Element_Kind (El_EE);

         if ASIS_UL.Options.ASIS_2005_Mode
           and then
           (EE_Kind = A_Function_Call
           or else
            EE_Kind = A_Procedure_Call_Statement)
          and then
            Is_Prefix_Notation (El_EE)
         then
            Idx_To_Compare := 2;
         end if;

         Result := Enclosing_List'Last >= Idx_To_Compare
                 and then
                   Is_Equal (El, Enclosing_List (Idx_To_Compare));
      end if;

      return Result;
   end Is_First_Association;

   ----------------------------------------
   -- Is_First_Prefix_Notation_Parameter --
   ----------------------------------------

   function Is_First_Prefix_Notation_Parameter (El : Element) return Boolean is
      Result  : Boolean := False;
      El_EE   : Element;
      EE_Kind : Flat_Element_Kinds;
   begin

      if Flat_Element_Kind (El) = A_Parameter_Association then

         El_EE   := Enclosing_Element (El);
         EE_Kind := Flat_Element_Kind (El_EE);

         if ASIS_UL.Options.ASIS_2005_Mode
           and then
            Is_Prefix_Notation (El_EE)
         then

            if EE_Kind = A_Function_Call then
               Result := Is_Equal (El, Function_Call_Parameters (El_EE) (1));
            elsif EE_Kind = A_Procedure_Call_Statement then
               Result := Is_Equal (El, Call_Statement_Parameters (El_EE) (1));
            end if;

         end if;

      end if;

      return Result;
   end Is_First_Prefix_Notation_Parameter;

   -----------------
   -- Is_Function --
   -----------------

   function Is_Function (El_Kind : Flat_Element_Kinds) return Boolean is
   begin

      return (El_Kind = A_Function_Declaration                  or else
              El_Kind = A_Function_Body_Declaration             or else
              El_Kind = A_Function_Renaming_Declaration         or else
              El_Kind = A_Generic_Function_Renaming_Declaration or else
              El_Kind = A_Function_Body_Stub                    or else
              El_Kind = A_Generic_Function_Declaration          or else
              El_Kind = A_Formal_Function_Declaration           or else
              El_Kind = An_Access_To_Function                   or else
              El_Kind = An_Access_To_Protected_Function         or else
              El_Kind = An_Anonymous_Access_To_Function         or else
              El_Kind = An_Anonymous_Access_To_Protected_Function);

   end Is_Function;

   -----------------------------------
   -- Is_Last_Pragma_In_Formal_Part --
   -----------------------------------

   function Is_Last_Pragma_In_Formal_Part (El : Element) return Boolean is
      Result  : Boolean := False;
      Encl_El : Asis.Element;
   begin

      if Flat_Element_Kind (El) in Flat_Pragma_Kinds then
         Encl_El := Enclosing_Element (El);

         if Flat_Element_Kind (Encl_El) in A_Flat_Generic_Declaration then

            declare
               Gen_Form_Pars : constant Asis.Element_List :=
                  Generic_Formal_Part (Encl_El, True);
            begin

               if not Is_Nil (Gen_Form_Pars) then
                  Result := Is_Equal (El, Gen_Form_Pars (Gen_Form_Pars'Last));
               end if;

            end;

         end if;

      end if;

      return Result;
   end Is_Last_Pragma_In_Formal_Part;

   ------------------------------------
   -- Is_Part_Of_Generic_Formal_Part --
   ------------------------------------

   function Is_Part_Of_Generic_Formal_Part (El : Element) return Boolean is
      Result  : Boolean := False;
      Formals : constant Asis.Element_List :=
         Generic_Formal_Part
           (Traversal_Stack.Top.The_Element,
            Include_Pragmas => True);
   begin

      --  The imnplementation uses
      --  GNATPP.General_Traversal_Stacks.Traversal_Stack.Top instead of
      --  Asis.Elements.Enclosing_Element because of the performance reasons.

      for J in Formals'Range loop

         if Is_Equal (El, Formals (J)) then
            Result := True;
            exit;
         end if;

      end loop;

      return Result;
   end Is_Part_Of_Generic_Formal_Part;

   ----------------------
   -- Is_Standard_Name --
   ----------------------

   function Is_Standard_Name (Defining_Name : Element) return Boolean is
      Result : Boolean := False;
   begin
      --  We use direct access to low-level Element structure to make this
      --  check as fast as possible

      if Element_Kind (Defining_Name) = A_Defining_Name
        and then
         Unit_Origin (Enclosing_Compilation_Unit (Defining_Name)) /=
         An_Application_Unit
      then
         Result := True;
      end if;

      return Result;
   end Is_Standard_Name;

   -------------------------
   -- Is_Terminal_Element --
   -------------------------

   function Is_Terminal_Element (E : Element) return Boolean is
      Result : Boolean := False;
   begin

      case Flat_Element_Kind (E) is
         when A_Defining_Identifier .. A_Defining_Not_Operator |
              A_Null_Component                                 |
              An_Others_Choice                                 |
              An_Integer_Literal .. An_Enumeration_Literal     |
              A_Null_Literal                                   |
              A_Null_Statement                                 =>

            Result := True;
         when others =>
            null;
      end case;

      return Result;
   end Is_Terminal_Element;

   --------------
   -- Is_Unary --
   --------------

   function Is_Unary (El_Kind : Flat_Element_Kinds) return Boolean is
   begin
      return (False
         or else El_Kind = A_Unary_Plus_Operator
         or else El_Kind = A_Unary_Minus_Operator
         or else El_Kind = An_Abs_Operator
         or else El_Kind = A_Not_Operator);
   end Is_Unary;

   ------------------------
   -- May_Have_Init_Expr --
   ------------------------

   function May_Have_Init_Expr
     (El_Kind : Flat_Element_Kinds)
      return    Boolean
   is
   begin

      return (False
         or else El_Kind = A_Variable_Declaration
         or else El_Kind = A_Constant_Declaration
         or else El_Kind = An_Integer_Number_Declaration
         or else El_Kind = A_Real_Number_Declaration
         or else El_Kind = A_Discriminant_Specification
         or else El_Kind = A_Component_Declaration
         or else El_Kind = A_Parameter_Specification
         or else El_Kind = A_Formal_Object_Declaration);

   end May_Have_Init_Expr;

   ---------------------
   -- Name_Text_Image --
   ---------------------

   function Name_Text_Image (El : Element) return Program_Text is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (El);
   begin

      case Arg_Kind is
         when A_Defining_Identifier |
              A_Defining_Enumeration_Literal =>
            return Defining_Name_Image (El);
         when Flat_Pragma_Kinds =>
            return Pragma_Name_Image (El);
         when An_Identifier =>
            return Name_Image (El);
         when others =>
            --  We are not supposed to be here
            pragma Assert (False);
            return "";
      end case;

   end Name_Text_Image;

   ------------------
   -- Operator_Len --
   ------------------

   function Operator_Len (Op : Element) return Natural is
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (Op);
      Result   : Natural;
   begin

      if Arg_Kind not in Flat_Operator_Symbol_Kinds then
         Result := 0;
      else

         case Arg_Kind is
            when An_And_Operator |
                 An_Xor_Operator |
                 A_Mod_Operator  |
                 A_Rem_Operator  |
                 An_Abs_Operator |
                 A_Not_Operator  =>

               Result := 3;

            when An_Or_Operator                   |
                 A_Not_Equal_Operator             |
                 A_Less_Than_Or_Equal_Operator    |
                 A_Greater_Than_Or_Equal_Operator |
                 An_Exponentiate_Operator         =>

               Result := 2;
            when others =>
               Result := 1;
         end case;

      end if;

      return Result;
   end Operator_Len;

   ---------------------
   -- Split_Paragraph --
   ---------------------

   function Split_Paragraph (E : Element) return Boolean is
      Result   : Boolean                     := False;
      Arg_Kind : constant Flat_Element_Kinds := Flat_Element_Kind (E);
   begin

      case Arg_Kind is
         when Flat_Pragma_Kinds =>
            Result := True;
         when Flat_Statement_Kinds =>
            Result := not Can_Be_Aligned (E);
         when Flat_Declaration_Kinds =>

            if Arg_Kind = A_Parameter_Specification then
               Result :=
                 Flat_Element_Kind (Enclosing_Element (E)) not in
                 Flat_Access_Definition_Kinds;
            else
               Result := not Can_Be_Aligned (E);
            end if;

         when others =>
            null;
      end case;

      return Result;
   end Split_Paragraph;

   ----------------------------
   -- Unique_Name_Definition --
   ----------------------------

   function Unique_Name_Definition
     (An_Identifier :  Element)
      return           Element
   is
      Result : Element := Nil_Element;
   begin
      Result := Corresponding_Name_Definition (An_Identifier);

      if Flat_Element_Kind (Result) = A_Defining_Expanded_Name then
         Result := Defining_Selector (Result);
      end if;

      return Result;
   exception
      when ASIS_Inappropriate_Element =>

         return Nil_Element;
   end Unique_Name_Definition;

end GNATPP.Asis_Utilities;
