libadalang_tools_24.0.0_d864b5a8/src/laltools-common.adb

------------------------------------------------------------------------------
--                                                                          --
--                             Libadalang Tools                             --
--                                                                          --
--                     Copyright (C) 2021-2022, AdaCore                     --
--                                                                          --
-- Libadalang Tools  is free software; you can redistribute it and/or modi- --
-- fy  it  under  terms of the  GNU General Public License  as published by --
-- the Free Software Foundation;  either version 3, or (at your option) any --
-- later version. This software  is distributed in the hope that it will be --
-- useful but  WITHOUT  ANY  WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY  or  FITNESS  FOR A PARTICULAR PURPOSE.                  --
--                                                                          --
-- As a special  exception  under  Section 7  of  GPL  version 3,  you are  --
-- granted additional  permissions described in the  GCC  Runtime  Library  --
-- Exception, version 3.1, as published by the Free Software Foundation.    --
--                                                                          --
-- You should have received a copy of the GNU General Public License and a  --
-- copy of the GCC Runtime Library Exception along with this program;  see  --
-- the files COPYING3 and COPYING.RUNTIME respectively.  If not, see        --
-- <http://www.gnu.org/licenses/>.                                          --
------------------------------------------------------------------------------

with Ada.Assertions; use Ada.Assertions;
with Ada.Characters.Handling;
with Ada.Characters.Latin_1;
with Ada.Containers; use Ada.Containers;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Wide_Wide_Fixed;
with Ada.Wide_Wide_Characters.Handling;

with GNATCOLL.Projects;
with GNATCOLL.VFS;

with GNAT.Traceback.Symbolic;

with Libadalang.Iterators;

with Laltools.Subprogram_Hierarchy; use Laltools.Subprogram_Hierarchy;

package body Laltools.Common is

   procedure Log
     (Trace   : GNATCOLL.Traces.Trace_Handle;
      E       : Ada.Exceptions.Exception_Occurrence;
      Message : String := "");
   --  Log an exception in the given traces, with an optional message.

   ---------
   -- "<" --
   ---------

   function "<" (Left, Right : Source_Location_Range) return Boolean is
   begin
      if Left.Start_Line = Right.Start_Line then
         return Left.Start_Column < Right.Start_Column;
      end if;

      return Left.Start_Line < Right.Start_Line;
   end "<";

   ------------------------
   -- Append_If_Not_Null --
   ------------------------

   procedure Append_If_Not_Null
     (Vector : in out Ada_List_Vector;
      List   : Ada_List'Class) is
   begin
      if not List.Is_Null then
         Vector.Append (List);
      end if;
   end Append_If_Not_Null;

   ---------------------------
   -- Compilation_Unit_Hash --
   ---------------------------

   function Compilation_Unit_Hash (Comp_Unit : Compilation_Unit)
                                   return Ada.Containers.Hash_Type is
   begin
      return Hash (Comp_Unit.As_Ada_Node);
   end Compilation_Unit_Hash;

   --------------
   -- Contains --
   --------------

   function Contains
     (Token   : Token_Reference;
      Pattern : Wide_Wide_String;
      As_Word : Boolean;
      Span    : out Source_Location_Range)
      return Boolean
   is
      T    : constant Text_Type :=
        Ada.Wide_Wide_Characters.Handling.To_Lower (Text (Token));
      Idx  : constant Integer := Ada.Strings.Wide_Wide_Fixed.Index
        (T, Pattern);
      Last : Integer;

      function Is_Word_Delimiter (C : Wide_Wide_Character) return Boolean;

      -----------------------
      -- Is_Word_Delimiter --
      -----------------------

      function Is_Word_Delimiter (C : Wide_Wide_Character) return Boolean is
      begin
         return not Ada.Wide_Wide_Characters.Handling.Is_Alphanumeric (C)
           and then C /= '_';
      end Is_Word_Delimiter;

   begin
      if Idx < T'First then
         return False;
      end if;

      --  Treat the Pattern as a word
      if As_Word then
         if Idx > T'First
           and then not Is_Word_Delimiter (T (Idx - 1))
         then
            return False;
         end if;

         Last := Idx + Pattern'Length;
         if Last <= T'Last
           and then not Is_Word_Delimiter (T (Last))
         then
            return False;
         end if;
      end if;

      Span := Sloc_Range (Data (Token));
      Span.Start_Column :=
        Span.Start_Column + Column_Number (Idx - T'First);
      Span.End_Column :=
        Span.Start_Column + Column_Number (Pattern'Length);
      return True;
   end Contains;

   ---------------------------------
   -- Count_Param_Spec_Parameters --
   ---------------------------------

   function Count_Param_Spec_Parameters
     (Param_Spec : Libadalang.Analysis.Param_Spec'Class)
      return Natural is
   begin
      return Count : Natural := 0 do
         if not Param_Spec.Is_Null then
            for Parameter of Param_Spec.F_Ids loop
               Count := Count + 1;
            end loop;
         end if;
      end return;
   end Count_Param_Spec_Parameters;

   ----------------------------
   -- Count_Subp_Param_Specs --
   ----------------------------

   function Count_Subp_Param_Specs
     (Subp_Params : Params'Class)
      return Natural is
   begin
      return Count : Natural := 0 do
         if not Subp_Params.Is_Null then
            for Param_Spec of Subp_Params.F_Params loop
               Count := Count + 1;
            end loop;
         end if;
      end return;
   end Count_Subp_Param_Specs;

   ---------------------------
   -- Count_Subp_Parameters --
   ---------------------------

   function Count_Subp_Parameters
     (Subp_Params : Params'Class)
      return Natural is
   begin
      return Count : Natural := 0 do
         if not Subp_Params.Is_Null then
            for Param_Spec of Subp_Params.F_Params loop
               Count := Count + Count_Param_Spec_Parameters (Param_Spec);
            end loop;
         end if;
      end return;
   end Count_Subp_Parameters;

   -----------------------
   -- Expand_SLOC_Range --
   -----------------------

   function Expand_SLOC_Range
     (Node : Ada_Node'Class)
      return Source_Location_Range
   is (Expand_SLOC_Range (Node.Unit, Node.Sloc_Range));

   -----------------------
   -- Expand_SLOC_Range --
   -----------------------

   function Expand_SLOC_Range
     (Unit       : Analysis_Unit;
      SLOC_Range : Source_Location_Range)
      return Source_Location_Range
   is
      use Ada.Strings.Wide_Wide_Fixed;

      Max_Line : constant Natural :=
        (if Unit.Root.Is_Null then 0
         else Natural (Unit.Root.Sloc_Range.End_Line) + 1);

      First_Line                 : constant Text_Type :=
        Unit.Get_Line (Positive (SLOC_Range.Start_Line));
      First_Line_First_Non_Blank : constant Natural :=
        Index_Non_Blank (First_Line) + 1 - Natural (First_Line'First);

      Last_Line         : constant Text_Type :=
        Unit.Get_Line (Positive (SLOC_Range.End_Line));
      Rest_Of_Last_Line : constant Text_Type :=
        Last_Line (Last_Line'First
                   + Natural (SLOC_Range.End_Column)
                   - 1
                   .. Last_Line'Last);
      First_Rest_Of_Last_Line_Non_Blank : constant Natural :=
        (if Rest_Of_Last_Line'Length = 0 then
            0
         else
            Index_Non_Blank (Rest_Of_Last_Line)
         + 1
         - Natural (Rest_Of_Last_Line'First));

      Next_Line_Number : Natural := Natural (SLOC_Range.End_Line) + 1;

   begin
      return Expanded_SLOC_Range : Source_Location_Range := SLOC_Range do
         --  Add leading whitespaces
         if First_Line_First_Non_Blank =
              Natural (SLOC_Range.Start_Column)
         then
            Expanded_SLOC_Range.Start_Column := 1;
         end if;

         if Rest_Of_Last_Line'Length /= 0 then
            --  There might be trailing whitespaces
            if First_Rest_Of_Last_Line_Non_Blank = 0 then
               --  Add trailing whitespaces
               Expanded_SLOC_Range.End_Column :=
                 Langkit_Support.Slocs.Column_Number (Last_Line'Length)
                 + 1;
               --  Add any blank lines after that
               loop
                  exit when Next_Line_Number = Max_Line;
                  declare
                     Next_Line                 : constant Text_Type :=
                       Unit.Get_Line (Next_Line_Number);
                     Next_Line_First_Non_Blank : constant Natural :=
                       (if Next_Line'Length /= 0 then
                          Index_Non_Blank (Next_Line)
                        else
                          0);
                  begin
                     exit when Next_Line'Length /= 0
                       and then Next_Line_First_Non_Blank /= 0;
                     Expanded_SLOC_Range.End_Line :=
                       Langkit_Support.Slocs.Line_Number
                         (Next_Line_Number);
                     Expanded_SLOC_Range.End_Column :=
                       Langkit_Support.Slocs.Column_Number
                         (Next_Line'Length)
                       + 1;
                  end;
                  Next_Line_Number := Next_Line_Number + 1;
               end loop;
            end if;

         else
            --  There are no trailing whitespaces nor non whitespace
            --  tokens, so simply add any blank lines that follow.
            loop
               exit when Next_Line_Number = Max_Line;
               declare
                  Next_Line                 : constant Text_Type :=
                    Unit.Get_Line (Next_Line_Number);
                  Next_Line_First_Non_Blank : constant Natural :=
                    (if Next_Line'Length /= 0 then
                       Index_Non_Blank (Next_Line)
                     else
                       0);
               begin
                  exit when Next_Line'Length /= 0
                    and then Next_Line_First_Non_Blank /= 0;
                  Expanded_SLOC_Range.End_Line :=
                    Langkit_Support.Slocs.Line_Number
                      (Next_Line_Number);
                  Expanded_SLOC_Range.End_Column :=
                    Langkit_Support.Slocs.Column_Number
                      (Next_Line'Length)
                    + 1;
               end;
               Next_Line_Number := Next_Line_Number + 1;
            end loop;
         end if;
      end return;
   end Expand_SLOC_Range;

   ------------------------
   -- Expand_SLOC_Ranges --
   ------------------------

   function Expand_SLOC_Ranges
     (Unit        : Analysis_Unit;
      SLOC_Ranges : Source_Location_Range_Ordered_Set)
      return Source_Location_Range_Ordered_Set is
   begin
      if Unit.Root.Is_Null then
         return SLOC_Ranges;
      end if;

      return Expanded_SLOC_Ranges : Source_Location_Range_Ordered_Set do
         for SLOC_Range of SLOC_Ranges loop
            Expanded_SLOC_Ranges.Include
              (Expand_SLOC_Range (Unit, SLOC_Range));
         end loop;
      end return;
   end Expand_SLOC_Ranges;

   -------------------------
   -- Find_All_References --
   -------------------------

   procedure Find_All_References
     (Node     : Defining_Name'Class;
      Units    : Analysis_Unit_Array;
      Callback : not null access procedure
        (Reference : Ref_Result;
         Stop      : in out Boolean))
   is
      Stop : Boolean := False;
   begin
      if Node.As_Defining_Name = No_Defining_Name then
         return;
      end if;

      for Ref of Node.P_Find_All_References (Units, False)
      loop
         Callback (Ref, Stop);
         exit when Stop;
      end loop;
   end Find_All_References;

   --------------------------------------
   -- Find_All_References_For_Renaming --
   --------------------------------------

   function Find_All_References_For_Renaming
     (Definition : Defining_Name;
      Units      : Analysis_Unit_Array)
      return Base_Id_Vectors.Vector
   is
      All_References : Base_Id_Vectors.Vector;
      Is_Param : constant Boolean :=
        Definition.P_Basic_Decl.Kind in Ada_Param_Spec_Range;
      Is_Subp  : constant Boolean :=
        Is_Subprogram (Definition.P_Basic_Decl);
   begin
      if Definition.P_Canonical_Part.F_Name.Kind = Ada_Dotted_Name then
         All_References.Append
           (Definition.P_Canonical_Part.F_Name.As_Dotted_Name.
              F_Suffix.As_Base_Id);
      else
         All_References.Append
           (Definition.P_Canonical_Part.F_Name.As_Base_Id);
      end if;

      for Reference of Definition.P_Find_All_References (Units) loop
         All_References.Append (Ref (Reference).As_Base_Id);
      end loop;

      declare
         Vector : constant Base_Id_Vectors.Vector :=
           (if Is_Param then Find_All_Param_References_In_Subp_Hierarchy
              (Definition.P_Canonical_Part, Units)
            elsif Is_Subp then Find_All_Subp_References_In_Subp_Hierarchy
              (Definition.P_Canonical_Part.P_Basic_Decl, Units)
            else
               Base_Id_Vectors.Empty_Vector);
      begin
         for X of Vector loop
            All_References.Append (X);
         end loop;
      end;

      return All_References;
   end Find_All_References_For_Renaming;

   --------------------------------------------
   -- Find_All_Param_References_In_Hierarchy --
   --------------------------------------------

   function Find_All_Param_References_In_Subp_Hierarchy
     (Param_Definition : Defining_Name;
      Units            : Analysis_Unit_Array)
      return Base_Id_Vectors.Vector
   is
      --  The semantic parent of this parameter can either be a subprogram
      --  declaration or an access to a subprogram definition.
      --  In the latter case, there is no need to rename the parameter in the
      --  entire hierarchy since Ada allows different names.
      --
      --  Example:
      --
      --     procedure Bar (Self : A; Baz : access procedure (P : Boolean))
      --     is abstract;
      --
      --     overriding
      --     procedure Bar (Self : B; Baz : access procedure (Q : Boolean));
      --
      --     The parameters of Baz have different names (P and Q) and this is
      --     allowed. Therefore, only references need to be renamed.

      Semantic_Parent         : constant Ada_Node :=
        Param_Definition.P_Semantic_Parent;
      Is_Semantic_Parent_Subp : constant Boolean :=
        not Semantic_Parent.Is_Null
        and then Semantic_Parent.Kind in Ada_Basic_Decl
        and then Is_Subprogram (Semantic_Parent.As_Basic_Decl);
      Semantic_Parent_Subp    : constant Basic_Decl :=
        (if Is_Semantic_Parent_Subp then Semantic_Parent.As_Basic_Decl
         else No_Basic_Decl);

      Hierarchy : constant Basic_Decl_Array :=
        (if Is_Semantic_Parent_Subp then
            Get_Subp_Hierarchy (Semantic_Parent_Subp, Units)
         else []);

      Param_References : Base_Id_Vectors.Vector;

   begin
      if Is_Semantic_Parent_Subp then
         --  This is a parameter of a non-anonymous subprogram declaration so
         --  rename it in whole hierarchy.

         for Decl of Hierarchy loop
            for Param_Spec of Decl.P_Subp_Spec_Or_Null.P_Params loop
               for Param of Param_Spec.F_Ids loop
                  if Param_Definition.Text = Param.Text then
                     Param_References.Append
                       (Param.P_Canonical_Part.F_Name.As_Base_Id);
                     for Reference of
                       Param.P_Canonical_Part.P_Find_All_References (Units)
                     loop
                        Param_References.Append (Ref (Reference).As_Base_Id);
                     end loop;
                  end if;
               end loop;
            end loop;
         end loop;

      else
         --  This is a parameter of an access to a subprogram definition, so
         --  only replace its references.

         for Reference of
           Param_Definition.P_Canonical_Part.P_Find_All_References (Units)
         loop
            Param_References.Append (Ref (Reference).As_Base_Id);
         end loop;
      end if;

      return Param_References;
   end Find_All_Param_References_In_Subp_Hierarchy;

   ------------------------------------------------
   -- Find_All_Subp_References_In_Subp_Hierarchy --
   ------------------------------------------------

   function Find_All_Subp_References_In_Subp_Hierarchy
     (Subp  : Basic_Decl;
      Units : Analysis_Unit_Array)
      return Base_Id_Vectors.Vector
   is
      Hierarchy : constant Basic_Decl_Array :=
        Get_Subp_Hierarchy (Subp, Units);

      Param_References : Base_Id_Vectors.Vector;
   begin
      for Decl of Hierarchy loop
         --  If Decl is a top level declaration then it can be a dotted name
         --  In that case, consider the suffix as the reference.

         if Decl.P_Defining_Name.F_Name.Kind in Ada_Dotted_Name then
            Param_References.Append
              (Decl.P_Defining_Name.F_Name.As_Dotted_Name.F_Suffix);
         else
            Param_References.Append (Decl.P_Defining_Name.F_Name.As_Base_Id);
         end if;

         for Reference of
           Decl.P_Defining_Name.P_Find_All_References (Units)
         loop
            Param_References.Append (Ref (Reference).As_Base_Id);
         end loop;
      end loop;
      return Param_References;
   end Find_All_Subp_References_In_Subp_Hierarchy;

   -------------------------
   -- Find_Canonical_Part --
   -------------------------

   function Find_Canonical_Part
     (Definition         : Defining_Name;
      Trace              : GNATCOLL.Traces.Trace_Handle;
      Imprecise_Fallback : Boolean := False)
      return Defining_Name
   is
      Canonical : Defining_Name;
   begin
      Canonical :=
        Definition.P_Canonical_Part (Imprecise_Fallback => Imprecise_Fallback);

      if Canonical = Definition then
         return No_Defining_Name;
      else
         return Canonical;
      end if;

   exception
      when E :  Libadalang.Common.Property_Error =>
         Log (Trace, E);
         return No_Defining_Name;
   end Find_Canonical_Part;

   ---------------------
   -- Is_Scopes_Owner --
   ---------------------

   function Is_Scopes_Owner
     (Node : Ada_Node'Class)
      return Boolean
   is (not Node.Is_Null
       and then (Is_Declarative_Part_Owner (Node)
                 or Is_Decl_Expr_Owner (Node)
                 or Is_Params_Owner (Node)));

   -----------------
   --  Get_Params --
   -----------------

   function Get_Params (Node : Ada_Node'Class) return Params is
   begin
      if Node.Is_Null then
         return No_Params;
      end if;

      --  Check if Node has a Subp_Spec

      if Node.Kind in Ada_Basic_Decl
        and then not Node.As_Basic_Decl.P_Subp_Spec_Or_Null.Is_Null
        and then Node.As_Basic_Decl.P_Subp_Spec_Or_Null.Kind in
          Ada_Subp_Spec_Range
      then
         return Node.As_Basic_Decl.P_Subp_Spec_Or_Null.As_Subp_Spec.
           F_Subp_Params;
      end if;

      --  Check for Entry_Decl / Accept_Stmt / Entry_Body

      if Node.Kind in Ada_Entry_Decl_Range then
         return Node.As_Entry_Decl.F_Spec.F_Entry_Params;

      elsif Node.Kind in Ada_Accept_Stmt_Range then
         if not Node.As_Accept_Stmt.F_Params.Is_Null then
            return Node.As_Accept_Stmt.F_Params.F_Params;
         end if;
         return No_Params;

      elsif Node.Kind in Ada_Entry_Body_Range then
         if not Node.As_Entry_Body.F_Params.Is_Null then
            return Node.As_Entry_Body.F_Params.F_Params;
         end if;
         return No_Params;

      else
         return No_Params;
      end if;
   end Get_Params;

   ---------------------
   -- Find_Other_Part --
   ---------------------

   function Find_Other_Part
     (List : Param_Spec_List'Class)
      return Param_Spec_List is
   begin
      if List.Is_Null then
         return No_Param_Spec_List;
      end if;

      declare
         Parent_Basic_Decl                   : constant Basic_Decl :=
           List.P_Parent_Basic_Decl;
         Parent_Basic_Decl_Other_Part        : constant Basic_Decl :=
           (if not Parent_Basic_Decl.P_Next_Part_For_Decl.Is_Null then
               Parent_Basic_Decl.P_Next_Part_For_Decl
            elsif not Parent_Basic_Decl.P_Previous_Part_For_Decl.Is_Null then
               Parent_Basic_Decl.P_Previous_Part_For_Decl
            else
               No_Basic_Decl);
         Parent_Basic_Decl_Other_Part_Params : constant Params :=
           Get_Params (Parent_Basic_Decl_Other_Part);
      begin
         --  If Parent_Basic_Decl does not have another part,
         --  or if it has but for some reason it does not have Params,
         --  return null.

         if Parent_Basic_Decl_Other_Part_Params.Is_Null then
            return No_Param_Spec_List;
         end if;

         return Parent_Basic_Decl_Other_Part_Params.F_Params;
      end;
   end Find_Other_Part;

   ------------------------------
   -- Find_First_Common_Parent --
   ------------------------------

   function Find_First_Common_Parent
     (Start_Node : Ada_Node'Class;
      End_Node   : Ada_Node'Class;
      With_Self  : Boolean := True)
      return Ada_Node is
   begin
      --  Return quickly if Start_Node and End_Node are not in the same
      --  Analysis_Unit.
      if Start_Node.Unit /= End_Node.Unit then
         return No_Ada_Node;
      end if;

      declare
         Start_Node_Parents : constant Ada_Node_Array :=
           Start_Node.Parents (With_Self);
         End_Node_Parents   : constant Ada_Node_Array :=
           End_Node.Parents (With_Self);
         Parents_Max_Length : constant Integer :=
           Integer'Min (Start_Node_Parents'Length, End_Node_Parents'Length);

         Enclosing_Common_Parent : Ada_Node := No_Ada_Node;

      begin
         for Parent_Index in Positive'First .. Parents_Max_Length loop
            exit when Start_Node_Parents
                        (Start_Node_Parents'Last - Parent_Index + 1) /=
                        End_Node_Parents
                          (End_Node_Parents'Last - Parent_Index + 1);
            Enclosing_Common_Parent :=
              Start_Node_Parents (Start_Node_Parents'Last - Parent_Index + 1);
         end loop;

         return Enclosing_Common_Parent;
      end;
   end Find_First_Common_Parent;

   procedure Include_If_Not_Null
     (Set     : in out Ada_List_Hashed_Set;
      Element : Param_Spec_List'Class);
   --  Checks if List is null, and if not, includes it in
   --  Enclosing_Param_Spec_List.

   procedure Include_If_Not_Null
     (Set     : in out Ada_List_Hashed_Set;
      Element : Param_Spec_List'Class) is
   begin
      if not Element.Is_Null then
         Set.Include (Element);
      end if;
   end Include_If_Not_Null;

   ----------------------------------
   -- Find_Enclosing_Declarative_Parts --
   ----------------------------------

   function Find_Enclosing_Declarative_Parts
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is
      Enclosing_Declarative_Parts : Ada_List_Hashed_Set;

      procedure Process_Scopes_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean);
      --  Checks if Owner has declarative parts, appending them to
      --  Enclosing_Declarative_Parts if so. If it doesn't, checks if its
      --  body part (if existent) has declarative parts, also appending them to
      --  Enclosing_Declarative_Parts.

      --------------------------
      -- Process_Scopes_Owner --
      --------------------------

      procedure Process_Scopes_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean) is
      begin
         if Is_Declarative_Part_Owner (Owner) then
            --  Owner has a Declarative_Part, include in the result and stop
            for Declarative_Part of Get_Declarative_Parts (Owner) loop
               Enclosing_Declarative_Parts.Include (Declarative_Part.F_Decls);
            end loop;

         elsif Is_Decl_Expr_Owner (Owner) then
            --  Owner has a Decl_Expr, include in the result and stop
            Enclosing_Declarative_Parts.Include
              (Owner.As_Expr_Function.F_Expr.As_Paren_Expr.F_Expr.
                 As_Decl_Expr.F_Decls);

         elsif Owner.Kind in Ada_Basic_Decl
           and then not Owner.As_Basic_Decl.P_Body_Part_For_Decl.Is_Null
           and then Is_Scopes_Owner (Owner.As_Basic_Decl.P_Body_Part_For_Decl)
         then
            --  Owner does not have a Declarative_Part nor a Decl_Expr,
            --  therefore, its a Params owner (see Is_Scopes_Owner) with a
            --  body part. Recursevily call this function to process that
            --  body since it might have a declarative part.
            Process_Scopes_Owner
              (Owner.As_Basic_Decl.P_Body_Part_For_Decl.As_Ada_Node, Stop);
         end if;

         Stop := True;
      end Process_Scopes_Owner;

   begin
      Find_Matching_Parents
        (Node     => Node,
         Match    => Is_Scopes_Owner'Access,
         Callback => Process_Scopes_Owner'Access);

      return Enclosing_Declarative_Parts;
   end Find_Enclosing_Declarative_Parts;

   -------------------------------------
   -- Find_Enclosing_Param_Spec_Lists --
   -------------------------------------

   function Find_Enclosing_Param_Spec_Lists
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is
      Enclosing_Param_Spec_Lists : Ada_List_Hashed_Set;
      Parent_Params             : Params := No_Params;
      Parent_Param_Spec_List    : Param_Spec_List := No_Param_Spec_List;

   begin
      for Parent of Node.Parents (With_Self => False) loop
         Parent_Params := Get_Params (Parent);

         if not Parent_Params.Is_Null then
            Parent_Param_Spec_List := Parent_Params.F_Params;
            Include_If_Not_Null
              (Enclosing_Param_Spec_Lists, Parent_Param_Spec_List);
            Include_If_Not_Null
              (Enclosing_Param_Spec_Lists,
               Find_Other_Part (Parent_Param_Spec_List));
         end if;

         --  Node's enclosing declarative part does not have an associated
         --  Param_Spec_List, or we found a Param_Spec_List.
         exit when not Parent_Param_Spec_List.Is_Null
                     or else Is_Declarative_Part_Owner (Parent);
      end loop;

      return Enclosing_Param_Spec_Lists;
   end Find_Enclosing_Param_Spec_Lists;

   ---------------------------
   -- Find_Enclosing_Scopes --
   ---------------------------

   function Find_Enclosing_Scopes
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is (Ada_List_Hashed_Sets.Union
       (Find_Enclosing_Declarative_Parts (Node),
          Find_Enclosing_Param_Spec_Lists (Node)));

   ------------------------------------
   -- Find_Visible_Declarative_Parts --
   ------------------------------------

   function Find_Visible_Declarative_Parts
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is
      --  TODO: Process_Scopes_Owner is very similar to the one defined in
      --  Find_Enclosing_Declarative_Parts. It does the exact same thing expect
      --  that it does it for all matching parents (not only the first match).
      --  Find a way to refactor this and remove the duplicated code.

      Visible_Declarative_Parts : Ada_List_Hashed_Set;

      procedure Process_Scopes_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean);
      --  Checks if Owner has declarative parts, appending them to
      --  Enclosing_Declarative_Parts if so. If it doesn't, checks if its
      --  body part (if existent) has declarative parts, also appending them to
      --  Enclosing_Declarative_Parts.

      --------------------------
      -- Process_Scopes_Owner --
      --------------------------

      procedure Process_Scopes_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean) is
      begin
         if Is_Declarative_Part_Owner (Owner) then
            --  Owner has a Declarative_Part, include in the result and
            --  continue with the next parent
            for Declarative_Part of Get_Declarative_Parts (Owner) loop
               Visible_Declarative_Parts.Include (Declarative_Part.F_Decls);
            end loop;

         elsif Is_Decl_Expr_Owner (Owner) then
            --  Owner has a Decl_Expr, include in the result and continue with
            --  the next parent
            Visible_Declarative_Parts.Include
              (Owner.As_Expr_Function.F_Expr.As_Paren_Expr.F_Expr.
                 As_Decl_Expr.F_Decls);

         elsif Owner.Kind in Ada_Basic_Decl
           and then not Owner.As_Basic_Decl.P_Body_Part_For_Decl.Is_Null
           and then Is_Scopes_Owner (Owner.As_Basic_Decl.P_Body_Part_For_Decl)
         then
            --  Owner does not have a Declarative_Part nor a Decl_Expr,
            --  therefore, its a Params owner (see Is_Scopes_Owner) with a
            --  body part. Recursevily call this function to process that
            --  body since it might have a declarative part.
            Process_Scopes_Owner
              (Owner.As_Basic_Decl.P_Body_Part_For_Decl.As_Ada_Node, Stop);
         end if;
      end Process_Scopes_Owner;

   begin
      Find_Matching_Parents
        (Node     => Node,
         Match    => Is_Scopes_Owner'Access,
         Callback => Process_Scopes_Owner'Access);

      return Visible_Declarative_Parts;
   end Find_Visible_Declarative_Parts;

   ------------------------------
   -- Find_Visible_Param_Specs --
   ------------------------------

   function Find_Visible_Param_Spec_Lists
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is
      Visible_Param_Spec_Lists  : Ada_List_Hashed_Set;
      Parent_Params             : Params := No_Params;
      Parent_Param_Spec_List    : Param_Spec_List := No_Param_Spec_List;

   begin
      for Parent of Node.Parents (With_Self => False) loop
         Parent_Params := Get_Params (Parent);

         if not Parent_Params.Is_Null then
            Parent_Param_Spec_List := Parent_Params.F_Params;
            Include_If_Not_Null
              (Visible_Param_Spec_Lists, Parent_Param_Spec_List);
            Include_If_Not_Null
              (Visible_Param_Spec_Lists,
               Find_Other_Part (Parent_Param_Spec_List));
         end if;
      end loop;

      return Visible_Param_Spec_Lists;
   end Find_Visible_Param_Spec_Lists;

   -------------------------
   -- Find_Visible_Scopes --
   -------------------------

   function Find_Visible_Scopes
     (Node : Ada_Node'Class)
      return Ada_List_Hashed_Set
   is (Ada_List_Hashed_Sets.Union
       (Find_Visible_Declarative_Parts (Node),
          Find_Visible_Param_Spec_Lists (Node)));

   ------------------------
   -- Find_Nested_Scopes --
   ------------------------

   function Find_Nested_Scopes
     (Node : Ada_Node'Class)
      return Declarative_Part_Vector
   is
      Nested_Declarative_Parts : Declarative_Part_Vectors.Vector;

      Parent_Declarative_Part_Owner : Ada_Node;

      procedure Set_Parent_Declarative_Part_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean);
      --  Callback of Find_Matching_Parents that sets
      --  Parent_Declarative_Part_Owner and stops the iteration.

      function Append_Nested_Declarative_Parts
        (This_Node : Ada_Node'Class)
         return Visit_Status;
      --  Callback of Find_Matching_Parents that checks if This_Node is a
      --  Declarative_Part, and if so, appends it to Nested_Declarative_Parts.

      -------------------------------------
      -- Append_Nested_Declarative_Parts --
      -------------------------------------

      function Append_Nested_Declarative_Parts
        (This_Node : Ada_Node'Class)
         return Visit_Status is
      begin
         if This_Node.Kind in Ada_Declarative_Part_Range then
            Nested_Declarative_Parts.Append (This_Node.As_Declarative_Part);
         end if;

         return Into;
      end Append_Nested_Declarative_Parts;

      ---------------------------------------
      -- Set_Parent_Declarative_Part_Owner --
      ---------------------------------------

      procedure Set_Parent_Declarative_Part_Owner
        (Owner : Ada_Node;
         Stop  : in out Boolean) is
      begin
         Parent_Declarative_Part_Owner := Owner;
         Stop := True;
      end Set_Parent_Declarative_Part_Owner;

      Body_Decl_Part    : Declarative_Part := No_Declarative_Part;
      Public_Decl_Part  : Public_Part := No_Public_Part;
      Private_Decl_Part : Private_Part := No_Private_Part;
      Stmts             : Handled_Stmts := No_Handled_Stmts;

   begin
      if Node.Is_Null then
         return Nested_Declarative_Parts;
      end if;

      if Is_Declarative_Part_Owner (Node) then
         Parent_Declarative_Part_Owner := Node.As_Ada_Node;

      else
         Find_Matching_Parents
           (Node     => Node,
            Match    => Is_Declarative_Part_Owner'Access,
            Callback => Set_Parent_Declarative_Part_Owner'Access);
      end if;

      if Parent_Declarative_Part_Owner.Is_Null then
         return Nested_Declarative_Parts;
      end if;

      case Parent_Declarative_Part_Owner.Kind is
         when Ada_Decl_Block_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Decl_Block.F_Decls;
            Stmts := Parent_Declarative_Part_Owner.As_Decl_Block.F_Stmts;

         when Ada_Entry_Body_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Entry_Body.F_Decls;
            Stmts := Parent_Declarative_Part_Owner.As_Entry_Body.F_Stmts;

         when Ada_Package_Body_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Package_Body.F_Decls;

            declare
               Pkg_Decl : constant Basic_Decl :=
                 Parent_Declarative_Part_Owner.As_Package_Body.
                   P_Canonical_Part;

            begin
               if not Pkg_Decl.Is_Null then
                  Public_Decl_Part :=
                    Pkg_Decl.As_Base_Package_Decl.F_Public_Part;
                  Private_Decl_Part :=
                    Pkg_Decl.As_Base_Package_Decl.F_Private_Part;
               end if;
            end;

         when Ada_Protected_Body_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Entry_Body.F_Decls;
            Stmts := Parent_Declarative_Part_Owner.As_Entry_Body.F_Stmts;

         when Ada_Subp_Body_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Subp_Body.F_Decls;
            Stmts := Parent_Declarative_Part_Owner.As_Subp_Body.F_Stmts;

         when Ada_Subp_Decl_Range =>
            declare
               Body_Part : constant Base_Subp_Body :=
                 Parent_Declarative_Part_Owner.As_Subp_Decl.P_Body_Part;
            begin
               if Body_Part.Kind in Ada_Subp_Body_Range then
                  Body_Decl_Part := Body_Part.As_Subp_Body.F_Decls;
                  Stmts := Body_Part.As_Subp_Body.F_Stmts;
               end if;
            end;

         when Ada_Task_Body_Range =>
            Body_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Task_Body.F_Decls;
            Stmts := Parent_Declarative_Part_Owner.As_Task_Body.F_Stmts;

         when Ada_Base_Package_Decl =>
            Public_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Base_Package_Decl.F_Public_Part;
            Private_Decl_Part :=
              Parent_Declarative_Part_Owner.
                As_Base_Package_Decl.F_Private_Part;

            declare
               Pkg_Body : constant Package_Body :=
                 Parent_Declarative_Part_Owner.As_Base_Package_Decl.
                   P_Body_Part;

            begin
               if not Pkg_Body.Is_Null then
                  Body_Decl_Part := Pkg_Body.F_Decls;
               end if;
            end;

         when Ada_Protected_Def_Range =>
            Public_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Protected_Def.F_Public_Part;
            Private_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Protected_Def.F_Private_Part;

         when Ada_Task_Def_Range =>
            Public_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Task_Def.F_Public_Part;
            Private_Decl_Part :=
              Parent_Declarative_Part_Owner.As_Task_Def.F_Private_Part;

         when others =>
            raise Assertion_Error;
      end case;

      if not Body_Decl_Part.Is_Null then
         Traverse
           (Body_Decl_Part.F_Decls,
            Append_Nested_Declarative_Parts'Access);
      end if;

      if not Public_Decl_Part.Is_Null then
         Traverse
           (Public_Decl_Part.F_Decls,
            Append_Nested_Declarative_Parts'Access);
      end if;

      if not Private_Decl_Part.Is_Null then
         Traverse
           (Private_Decl_Part.F_Decls,
            Append_Nested_Declarative_Parts'Access);
      end if;

      if not Stmts.Is_Null then
         Traverse (Stmts, Append_Nested_Declarative_Parts'Access);
      end if;

      return Nested_Declarative_Parts;
   end Find_Nested_Scopes;

   --------------------
   -- Find_Next_Part --
   --------------------

   function Find_Next_Part
     (Definition         : Defining_Name;
      Trace              : GNATCOLL.Traces.Trace_Handle;
      Imprecise_Fallback : Boolean := False)
      return Defining_Name
   is
      Next : Defining_Name;
   begin
      Next :=
        Definition.P_Next_Part (Imprecise_Fallback => Imprecise_Fallback);

      if Next = Definition then
         return No_Defining_Name;
      else
         return Next;
      end if;
   exception
      when E :  Libadalang.Common.Property_Error =>
         Log (Trace, E);
         return No_Defining_Name;
   end Find_Next_Part;

   -----------------------------
   -- Find_Next_Part_For_Decl --
   -----------------------------

   function Find_Next_Part_For_Decl
     (Decl               : Basic_Decl;
      Trace              : GNATCOLL.Traces.Trace_Handle;
      Imprecise_Fallback : Boolean := False)
      return Basic_Decl
   is
      Next : Basic_Decl;
   begin
      Next :=
        Decl.P_Next_Part_For_Decl
          (Imprecise_Fallback => Imprecise_Fallback);

      if Next = Decl then
         return No_Basic_Decl;
      else
         return Next;
      end if;
   exception
      when E :  Libadalang.Common.Property_Error =>
         Log (Trace, E);
         return No_Basic_Decl;

   end Find_Next_Part_For_Decl;

   ------------------------
   -- Find_Previous_Part --
   ------------------------

   function Find_Previous_Part
     (Definition         : Defining_Name;
      Trace              : GNATCOLL.Traces.Trace_Handle;
      Imprecise_Fallback : Boolean := False)
      return Defining_Name
   is
      Next : Defining_Name;
   begin
      Next :=
        Definition.P_Previous_Part (Imprecise_Fallback => Imprecise_Fallback);

      if Next = Definition then
         return No_Defining_Name;
      else
         return Next;
      end if;
   exception
      when E :  Libadalang.Common.Property_Error =>
         Log (Trace, E);
         return No_Defining_Name;
   end Find_Previous_Part;

   ------------------------------
   -- Find_Other_Part_Fallback --
   ------------------------------

   function Find_Other_Part_Fallback
     (Definition : Defining_Name;
      Trace      : GNATCOLL.Traces.Trace_Handle)
      return Defining_Name
   is
      Qualified_Name : constant Langkit_Support.Text.Text_Type :=
        Definition.P_Basic_Decl.P_Fully_Qualified_Name;
      --  The name that we'll try to match

      Found : Defining_Name := No_Defining_Name;
      --  The result that has been found

      function Matches
        (Node : Ada_Node'Class) return Visit_Status;
      --  Return True if the name of Node matches Qualified_Name

      -------------
      -- Matches --
      -------------

      function Matches
        (Node : Ada_Node'Class) return Visit_Status is
      begin
         if Node.Is_Null then
            return Libadalang.Common.Into;
         end if;

         --  Note: in this function, we are simply looking at the first
         --  result that matches.
         --  TODO: improve this by find all entities that match, and
         --  finding the best through a distance/scoring heuristics.
         if Node.Kind in Libadalang.Common.Ada_Basic_Decl then
            declare
               Decl     : constant Basic_Decl := Node.As_Basic_Decl;
               Def      : constant Defining_Name := Decl.P_Defining_Name;
               Def_Name : constant Langkit_Support.Text.Text_Type :=
                 Decl.P_Fully_Qualified_Name;
            begin
               --  Search a declaration with the same qualified_name which is
               --  not Definition itself.
               if Def /= Definition
                 and then Def_Name = Qualified_Name
               then
                  Found := Def;
                  return Libadalang.Common.Stop;
               end if;
            end;
         end if;

         return Libadalang.Common.Into;

      exception
         when Property_Error =>
            return Libadalang.Common.Into;
      end Matches;

      Parent_Node  : Ada_Node := No_Ada_Node;
      Current_Root : Defining_Name;
      Other_Root   : Defining_Name;
   begin
      --  The heuristics implemented is the following: we're looking at the
      --  spec and body of the enclosing entity, to find an entity that
      --  could correspond to Definition.
      --
      --  For instance, if Definition points to a function Foo that is defined
      --  in a package P, we're going to look in the spec and body of P for
      --  any items named Foo, excluding Definition itself.

      --  Eliminate some cases. The subprogram does not have an other part if
      --  it is an expression function, or an abstract subprogram declaration,
      --  or a null procedure.

      if Laltools.Common.Is_Definition_Without_Separate_Implementation
        (Definition)
      then
         return No_Defining_Name;
      end if;

      --  First obtain the highest level declaration of the current tree
      declare
         All_Parents : constant Ada_Node_Array := Definition.Parents;
      begin
         for P of reverse All_Parents loop
            if P.Kind in Ada_Basic_Decl then
               Parent_Node := P;
               exit;
            end if;
         end loop;
      end;

      if Parent_Node = No_Ada_Node then
         return No_Defining_Name;
      end if;

      --  Traverse the current tree. The visiting function assigns the matching
      --  result, if any, to Found.
      Parent_Node.Traverse (Matches'Unrestricted_Access);

      if Found = No_Defining_Name then
         Current_Root := Parent_Node.As_Basic_Decl.P_Defining_Name;
         --  Try Next_Part and then Previous_Part to find the body/spec of
         --  the current root.
         Other_Root := Laltools.Common.Find_Next_Part (Current_Root, Trace);
         if Other_Root = No_Defining_Name then
            Other_Root := Laltools.Common.Find_Previous_Part
              (Current_Root, Trace);
         end if;
         --  Traverse the other root
         if Other_Root /= No_Defining_Name then
            Other_Root.Parent.Traverse (Matches'Unrestricted_Access);
         end if;
      end if;

      return Found;

   exception
      when E : Property_Error =>
         Log (Trace, E);
         return No_Defining_Name;
   end Find_Other_Part_Fallback;

   --------------------
   -- Find_Subp_Body --
   --------------------

   function Find_Subp_Body (Subp : Basic_Decl'Class) return Base_Subp_Body is
   begin
      case Subp.Kind is
         when Ada_Subp_Decl_Range =>
            return Subp.As_Subp_Decl.P_Body_Part;

         when Ada_Generic_Subp_Decl_Range =>
            return Subp.As_Generic_Subp_Decl.P_Body_Part;

         when others =>
            return No_Base_Subp_Body;
      end case;
   end Find_Subp_Body;

   --------------------------------------
   -- Get_Basic_Decl_Header_SLOC_Range --
   --------------------------------------

   function Get_Basic_Decl_Header_SLOC_Range
     (Decl : Basic_Decl'Class)
      return Source_Location_Range
   is
      use Ada.Strings;
      use Ada.Strings.Fixed;

      --  ---------------------  -> This is a header edge
      --  -- Subprogram_Name --  -> This is the header body
      --  ---------------------  -> This is a header edge

      function Is_Header_Edge
        (Token           : Token_Reference;
         Subprogram_Name : String)
         return Boolean
      is (Trim (To_UTF8 (Text (Token)), Both) =
            String'((Subprogram_Name'Length + 6) * "-"));
      --  Checks if Token is the header edge

      function Is_Header_Body
        (Token           : Token_Reference;
         Subprogram_Name : String)
         return Boolean
      is (Trim (To_UTF8 (Text (Token)), Both) =
            "-- " & Subprogram_Name & " --");
      --  Checks if Token is the header body

      function Line_Feed_Count
        (Token : Token_Reference)
         return Natural
      is (Ada.Strings.Fixed.Count
            (To_UTF8 (Text (Token)),
             String'("" & Ada.Characters.Latin_1.LF)));
      --  Counts the number of LFs in Token

   begin
      --  Do not try to recognize headers on declaration without Defining_Name
      --  nodes or declarations with multiple Defining_Name nodes.
      if Decl.Is_Null
        or else Decl.P_Defining_Name.Is_Null
        or else Decl.P_Defining_Names'Length > 1
      then
         return No_Source_Location_Range;
      end if;

      declare
         Decl_Name : constant String := To_UTF8 (Decl.P_Defining_Name.Text);
         --  Calling Decl.P_Defining_Name is safe here because we've checked
         --  that Decl.P_Defining_Names'Length > 1.

         Decl_Start_Token : constant Token_Reference := Decl.Token_Start;
         Aux_Token        : Token_Reference := Decl_Start_Token;

         Header_Start_Token : Token_Reference;
         Header_End_Token   : Token_Reference;

      begin
         --  Start with the first token of Decl

         --  Move backward one token and confirm that:
         --    - it is a whitespace token with at least one line break and at
         --      most two
         Aux_Token := Previous (Aux_Token);
         if Aux_Token = No_Token
           or else Kind (Data (Aux_Token)) not in Ada_Whitespace
           or else Line_Feed_Count (Aux_Token) not in 1 | 2
         then
            return No_Source_Location_Range;
         end if;

         --  Move backward one token and confirm that:
         --    - it is a whole line comment
         --    - and then that it is a header edge
         --    - and then that it starts at the same column as Decl
         --  If the previous conditions pass then it means this might be a
         --  header end, so assign save it in Header_End_Token.
         Aux_Token := Previous (Aux_Token);
         if not Is_Whole_Line_Comment (Aux_Token)
           or else not Is_Header_Edge (Aux_Token, Decl_Name)
           or else Sloc_Range (Data (Aux_Token)).Start_Column /=
                     Decl.Sloc_Range.Start_Column
         then
            return No_Source_Location_Range;
         end if;
         Header_End_Token := Aux_Token;

         --  Move backward one token and confirm that:
         --    - it is whitespace token
         --    - and then that it only has one line break
         Aux_Token := Previous (Aux_Token);
         if Aux_Token = No_Token
           or else Kind (Data (Aux_Token)) not in Ada_Whitespace
           or else Line_Feed_Count (Aux_Token) /= 1
         then
            return No_Source_Location_Range;
         end if;

         --  Move backward one token and confirm that:
         --    - it is a whole line comment
         --    - and then that it is a header body
         --    - and then that it starts at the same column as Decl
         Aux_Token := Previous (Aux_Token);
         if not Is_Whole_Line_Comment (Aux_Token)
           or else not Is_Header_Body (Aux_Token, Decl_Name)
           or else Sloc_Range (Data (Aux_Token)).Start_Column /=
                     Decl.Sloc_Range.Start_Column
         then
            return No_Source_Location_Range;
         end if;

         --  Move backward one token and confirm that:
         --    - it is whitespace token
         --    - and then that it only has one line break
         Aux_Token := Previous (Aux_Token);
         if Aux_Token = No_Token
           or else Kind (Data (Aux_Token)) not in Ada_Whitespace
           or else Line_Feed_Count (Aux_Token) /= 1
         then
            return No_Source_Location_Range;
         end if;

         --  Move backward one token and confirm that:
         --    - it is a whole line comment
         --    - and then that it is a header edge
         --    - and then that it starts at the same column as Decl
         --  If the previous conditions pass then it means this is the header
         --  start, so assign save it in Header_Start_Token.
         Aux_Token := Previous (Aux_Token);
         if not Is_Whole_Line_Comment (Aux_Token)
           or else not Is_Header_Edge (Aux_Token, Decl_Name)
           or else Sloc_Range (Data (Aux_Token)).Start_Column /=
                     Decl.Sloc_Range.Start_Column
         then
            return No_Source_Location_Range;
         end if;
         Header_Start_Token := Aux_Token;

         --  Header_Start_Token token might not start at column 1. However,
         --  tt is safe to create a start Source_Location with column
         --  1 because we confirmed that Header_Start_Token is a whole line
         --  comment.
         return
           Make_Range
             (Source_Location'
                (Sloc_Range (Data (Header_Start_Token)).Start_Line, 1),
              End_Sloc (Sloc_Range (Data (Header_End_Token))));
      end;
   end Get_Basic_Decl_Header_SLOC_Range;

   --------------------------
   -- Get_Compilation_Unit --
   --------------------------

   function Get_Compilation_Unit
     (Node : Ada_Node'Class)
      return Compilation_Unit
   is
      C_Unit : Ada_Node :=
        (if Node.Is_Null then No_Ada_Node else Node.As_Ada_Node);

   begin
      --  Iterate throught the parents until a Compilation_Unit node is
      --  found
      while not C_Unit.Is_Null
        and then not (C_Unit.Kind in Ada_Compilation_Unit_Range)
      loop
         C_Unit := C_Unit.Parent;
      end loop;

      if C_Unit.Is_Null
        or else not (C_Unit.Kind in Ada_Compilation_Unit_Range)
      then
         return No_Compilation_Unit;
      end if;

      return C_Unit.As_Compilation_Unit;
   end Get_Compilation_Unit;

   ---------------------------
   -- Get_Compilation_Units --
   ---------------------------

   function Get_Compilation_Units
     (Analysis_Unit : Libadalang.Analysis.Analysis_Unit)
      return Compilation_Unit_Vector
   is
      Root : constant Ada_Node :=
        (if Analysis_Unit = No_Analysis_Unit then No_Ada_Node
         else Analysis_Unit.Root);
   begin
      return Compilation_Units : Compilation_Unit_Vector do
         if not Root.Is_Null then
            case Root.Kind is
               when Ada_Compilation_Unit =>
                  Compilation_Units.Append (Root.As_Compilation_Unit);
               when Ada_Compilation_Unit_List =>
                  for Node of Root.As_Compilation_Unit_List loop
                     Compilation_Units.Append (Node.As_Compilation_Unit);
                  end loop;
               when others => null;
            end case;
         end if;
      end return;
   end Get_Compilation_Units;

   ------------------------------
   -- Get_Insert_With_Location --
   ------------------------------

   function Get_Insert_With_Location
     (Node      : Compilation_Unit'Class;
      Pack_Name : Text_Type;
      Last      : out Boolean)
      return Source_Location
   is
      --  Cover the no with clause case
      Res                  : Source_Location := Start_Sloc (Node.Sloc_Range);
      Searching_Insert_Loc : Boolean := True;
   begin
      Last := False;
      for N of Node.F_Prelude loop
         if N.Kind in Ada_With_Clause_Range then
            --  Handle list of packages: "with A, B, C;"
            for P of N.As_With_Clause.F_Packages loop
               if Pack_Name = P.Text then
                  --  We are already withed
                  return No_Source_Location;
               elsif Searching_Insert_Loc
                 and then Pack_Name < P.Text
               then
                  --  Assuming the with clauses are sorted alphabetically,
                  --  the insert location is before the first clause higher
                  --  than us. (Attention we must insert before N and not P)
                  Last := False;
                  Res := Start_Sloc (N.Sloc_Range);
                  Searching_Insert_Loc := False;
               end if;
            end loop;
         end if;

         if Searching_Insert_Loc
           and then N.Kind in Ada_With_Clause_Range | Ada_Use_Package_Clause
         then
            --  If the highest alphabetically, insert it after the last
            --  with clause. To not split a pair also keep track of the last
            --  use clause.
            Last := True;
            Res := End_Sloc (N.Sloc_Range);
         end if;
      end loop;

      return Res;
   end Get_Insert_With_Location;

   ---------------------------
   -- Find_Matching_Parents --
   ---------------------------

   procedure Find_Matching_Parents
     (Node     : Ada_Node'Class;
      Match    : not null access function
        (Node : Ada_Node'Class) return Boolean;
      Callback : not null access procedure
        (Parent : Ada_Node;
         Stop   : in out Boolean))
   is
      Parent : Ada_Node :=
        (if Node.Is_Null then No_Ada_Node else Node.Parent);
      Stop   : Boolean := False;

   begin
      while not Stop loop
         exit when Parent.Is_Null;

         if Match (Parent) then
            Callback (Parent, Stop);
         end if;

         Parent := Parent.Parent;
      end loop;
   end Find_Matching_Parents;

   ----------------------------
   -- Get_Ada_Analysis_Units --
   ----------------------------

   function Get_Ada_Analysis_Units
     (Source_Provider  : Libadalang.Helpers.Source_Provider;
      Analysis_Context : Libadalang.Analysis.Analysis_Context)
      return Analysis_Unit_Array
   is
      use Ada.Characters.Handling;
      use GNATCOLL.Projects;
      use GNATCOLL.VFS;

      function Is_Ada_File (File : Virtual_File) return Boolean is
        (declare Set : constant File_Info_Set :=
           Source_Provider.Project.Info_Set (File);
         begin
           --  The file can be listed in several projects with different
           --  Info_Sets, in the case of aggregate projects. However, assume
           --  that the language is the same in all projects, so look only
           --  at the first entry in the set.
           not Set.Is_Empty
           and then To_Lower (File_Info'Class (Set.First_Element).Language) =
                      "ada");
      --  Checks if File is an Ada source file

      Files          : constant File_Array_Access :=
        Source_Provider.Project.Root_Project.Source_Files;
      Analysis_Units : Analysis_Unit_Array (1 .. Files'Length);
      Counter        : Natural := 0;

   begin
      for File of Files.all loop
         if Is_Ada_File (File) then
            Counter := Counter + 1;
            Analysis_Units (Counter) :=
              Analysis_Context.Get_From_File (+File.Full_Name);
         end if;
      end loop;

      return Analysis_Units (1 .. Counter);
   end Get_Ada_Analysis_Units;

   -------------------------------------
   -- Get_Decl_Block_Declarative_Part --
   -------------------------------------

   function Get_Decl_Block_Declarative_Part
     (Decl_B : Decl_Block) return Declarative_Part is
   begin
      if Decl_B = No_Decl_Block then
         return No_Declarative_Part;
      end if;

      return Decl_B.F_Decls;
   end Get_Decl_Block_Declarative_Part;

   --------------------------
   -- Get_Decl_Block_Decls --
   --------------------------

   function Get_Decl_Block_Decls (Decl_B : Decl_Block) return Ada_Node_List is
   begin
      if Decl_B = No_Decl_Block then
         return No_Ada_Node_List;
      end if;

      return Decl_B.F_Decls.F_Decls;
   end Get_Decl_Block_Decls;

   --------------------------
   -- Get_Declarative_Part --
   --------------------------

   function Get_Declarative_Part
     (Node         : Ada_Node'Class;
      Private_Part : Boolean := False)
      return Declarative_Part
   is
      function Get_Declarative_Part_From_Owner
        (This_Node : Ada_Node'Class)
         return Declarative_Part;
      --  Gets the Declarative_Part node of This_Node

      -------------------------------------
      -- Get_Declarative_Part_From_Owner --
      -------------------------------------

      function Get_Declarative_Part_From_Owner
        (This_Node : Ada_Node'Class)
         return Declarative_Part is
      begin
         case This_Node.Kind is
            when Ada_Decl_Block_Range =>
               return This_Node.As_Decl_Block.F_Decls;

            when Ada_Entry_Body_Range =>
               return This_Node.As_Entry_Body.F_Decls;

            when Ada_Package_Body_Range =>
               return This_Node.As_Package_Body.F_Decls;

            when Ada_Protected_Body_Range =>
               return This_Node.As_Entry_Body.F_Decls;

            when Ada_Subp_Body_Range =>
               return This_Node.As_Subp_Body.F_Decls;

            when Ada_Subp_Decl_Range =>
               declare
                  Body_Part : constant Base_Subp_Body :=
                    This_Node.As_Subp_Decl.P_Body_Part;
               begin
                  return
                    (if Body_Part.Kind in Ada_Subp_Body_Range then
                        Body_Part.As_Subp_Body.F_Decls
                     else
                        No_Declarative_Part);
               end;

            when Ada_Task_Body_Range =>
               return This_Node.As_Task_Body.F_Decls;

            when Ada_Base_Package_Decl =>
               return (if Private_Part then
                          This_Node.As_Base_Package_Decl.F_Private_Part.
                            As_Declarative_Part
                       else
                          This_Node.As_Base_Package_Decl.F_Public_Part.
                            As_Declarative_Part);

            when Ada_Protected_Def_Range =>
               return (if Private_Part then
                          This_Node.As_Protected_Def.F_Private_Part.
                            As_Declarative_Part
                       else
                          This_Node.As_Protected_Def.F_Public_Part.
                            As_Declarative_Part);

            when Ada_Task_Def_Range =>
               return (if Private_Part then
                          This_Node.As_Task_Def.F_Private_Part.
                            As_Declarative_Part
                       else
                          This_Node.As_Task_Def.F_Public_Part.
                            As_Declarative_Part);

            when others =>
               raise Assertion_Error;
         end case;
      end Get_Declarative_Part_From_Owner;

   begin
      if Node.Kind in Ada_Handled_Stmts_Range
        and then Is_Declarative_Part_Owner (Node.Parent)
      then
         return Get_Declarative_Part_From_Owner (Node.Parent);

      elsif Is_Declarative_Part_Owner (Node) then
         return Get_Declarative_Part_From_Owner (Node);

      else
         raise Assertion_Error;
      end if;
   end Get_Declarative_Part;

   ---------------------------
   -- Get_Declarative_Parts --
   ---------------------------

   function Get_Declarative_Parts
     (Node : Ada_Node'Class)
      return Declarative_Part_Vector
   is
      Declarative_Parts : Declarative_Part_Vector;

      Body_Decl_Part    : Declarative_Part := No_Declarative_Part;
      Public_Decl_Part  : Public_Part := No_Public_Part;
      Private_Decl_Part : Private_Part := No_Private_Part;

      procedure Safe_Append (Decl_Part : Declarative_Part'Class);

      procedure Safe_Append (Decl_Part : Declarative_Part'Class) is
      begin
         if not Decl_Part.Is_Null then
            Declarative_Parts.Append (Decl_Part);
         end if;
      end Safe_Append;

   begin
      case Node.Kind is
         when Ada_Decl_Block_Range =>
            Body_Decl_Part := Node.As_Decl_Block.F_Decls;

         when Ada_Entry_Body_Range =>
            Body_Decl_Part := Node.As_Entry_Body.F_Decls;

         when Ada_Package_Body_Range =>
            Body_Decl_Part := Node.As_Package_Body.F_Decls;

            declare
               Pkg_Decl : constant Basic_Decl :=
                 Node.As_Package_Body.P_Canonical_Part;

            begin
               if not Pkg_Decl.Is_Null then
                  Public_Decl_Part :=
                    Pkg_Decl.As_Base_Package_Decl.F_Public_Part;
                  Private_Decl_Part :=
                    Pkg_Decl.As_Base_Package_Decl.F_Private_Part;
               end if;
            end;

         when Ada_Protected_Body_Range =>
            Body_Decl_Part := Node.As_Entry_Body.F_Decls;

         when Ada_Subp_Body_Range =>
            Body_Decl_Part := Node.As_Subp_Body.F_Decls;

         when Ada_Subp_Decl_Range =>
            declare
               Body_Part : constant Base_Subp_Body :=
                 Node.As_Subp_Decl.P_Body_Part;

            begin
               if Body_Part.Kind in Ada_Subp_Body_Range then
                  Body_Decl_Part := Body_Part.As_Subp_Body.F_Decls;
               end if;
            end;

         when Ada_Task_Body_Range =>
            Body_Decl_Part := Node.As_Task_Body.F_Decls;

         when Ada_Base_Package_Decl =>
            Public_Decl_Part := Node.As_Base_Package_Decl.F_Public_Part;
            Private_Decl_Part := Node.As_Base_Package_Decl.F_Private_Part;

            declare
               Pkg_Body : constant Package_Body :=
                 Node.As_Base_Package_Decl.P_Body_Part;

            begin
               if not Pkg_Body.Is_Null then
                  Body_Decl_Part := Pkg_Body.F_Decls;
               end if;
            end;

         when Ada_Protected_Def_Range =>
            Public_Decl_Part := Node.As_Protected_Def.F_Public_Part;
            Private_Decl_Part := Node.As_Protected_Def.F_Private_Part;

         when Ada_Task_Def_Range =>
            Public_Decl_Part := Node.As_Task_Def.F_Public_Part;
            Private_Decl_Part := Node.As_Task_Def.F_Private_Part;

         when others =>
            raise Assertion_Error;
      end case;

      Safe_Append (Body_Decl_Part);
      Safe_Append (Public_Decl_Part);
      Safe_Append (Private_Decl_Part);

      return Declarative_Parts;
   end Get_Declarative_Parts;

   --------------------------
   -- Get_Defining_Name_Id --
   --------------------------

   function Get_Defining_Name_Id (Definition : Defining_Name)
                                  return Identifier is
   begin
      case Definition.F_Name.Kind is
         when Ada_Identifier =>
            return Definition.F_Name.As_Identifier;

         when Ada_Dotted_Name =>
            return Definition.F_Name.As_Dotted_Name.F_Suffix.As_Identifier;

         when others =>
            raise Program_Error;
      end case;
   end Get_Defining_Name_Id;

   --------------------------------
   -- Get_Dotted_Name_First_Name --
   --------------------------------

   function Get_Dotted_Name_First_Name
     (Dotted_Name : Libadalang.Analysis.Dotted_Name'Class)
      return Name is
   begin
      if Dotted_Name.Is_Null then
         return No_Name;
      end if;

      declare
         Prefix : Name := Dotted_Name.F_Prefix;

      begin
         while Prefix.Kind in Ada_Dotted_Name loop
            Prefix := Prefix.As_Dotted_Name.F_Prefix;
         end loop;

         return Prefix;
      end;
   end Get_Dotted_Name_First_Name;

   ---------------------------------
   -- Get_Dotted_Name_Definitions --
   ---------------------------------

   function Get_Dotted_Name_Definitions
     (Dotted_Name : Libadalang.Analysis.Dotted_Name'Class)
      return Defining_Name_Array
   is
   begin
      if Dotted_Name.Is_Null then
         return [];
      end if;

      declare
         Prefix      : Name;
         Names_Count : Natural := 2;

      begin
         --  Do a first pass to count how many names there are. This is very
         --  quick since only syntax queries are done.
         Prefix := Dotted_Name.F_Prefix;
         while Prefix.Kind in Ada_Dotted_Name loop
            Names_Count := @ + 1;
            Prefix := Prefix.As_Dotted_Name.F_Prefix;
         end loop;

         --  Do a second pass where we get the defining name of each name
         declare
            Index : Positive := 1;
            Defining_Names : Defining_Name_Array (1 .. Names_Count);
         begin
            Defining_Names (Index) :=
              Dotted_Name.F_Suffix.P_Referenced_Defining_Name;
            Prefix := Dotted_Name.F_Prefix;
            Index := @ + 1;
            while Prefix.Kind in Ada_Dotted_Name loop
               Defining_Names (Index) :=
                 Prefix.As_Dotted_Name.F_Prefix.P_Referenced_Defining_Name;
               Index := @ + 1;
               Prefix := Prefix.As_Dotted_Name.F_Prefix;
            end loop;
            Defining_Names (Index) :=
              Dotted_Name.F_Prefix.P_Referenced_Defining_Name;
            return Defining_Names;
         end;
      end;
   end Get_Dotted_Name_Definitions;

   --------------------------------------------
   --  Get_First_Identifier_From_Declaration --
   --------------------------------------------

   function Get_First_Identifier_From_Declaration
     (Decl : Basic_Decl'Class) return Identifier
   is
      Node : constant Ada_Node :=
        Libadalang.Iterators.Find_First
          (Decl, Libadalang.Iterators.Kind_Is (Ada_Identifier));
   begin
      if Node /= No_Ada_Node then
         return Node.As_Identifier;
      else
         return No_Identifier;
      end if;
   end Get_First_Identifier_From_Declaration;

   -------------------
   -- Get_Last_Name --
   -------------------

   function Get_Last_Name (Name_Node : Name)
                           return Unbounded_Text_Type
   is
      Names : constant Unbounded_Text_Type_Array :=
        P_As_Symbol_Array (Name_Node);
   begin
      return Names (Names'Last);
   end Get_Last_Name;

   --------------------------
   -- Get_Name_As_Defining --
   --------------------------

   function Get_Name_As_Defining (Name_Node : Name)
                                  return Defining_Name is
   begin
      if Name_Node = No_Name or else not Name_Node.P_Is_Defining
      then
         return No_Defining_Name;
      end if;

      return Name_Node.P_Enclosing_Defining_Name;
   end Get_Name_As_Defining;

   ----------------------------------
   -- Get_Enclosing_Declarative_Part --
   ----------------------------------

   function Get_Enclosing_Declarative_Part
     (Node : Ada_Node'Class)
      return Declarative_Part
   is
      Nearest_Declarative_Part : Declarative_Part :=
        No_Declarative_Part;

      procedure Set_Declarative_Part
        (Parent : Ada_Node;
         Stop   : in out Boolean);
      --  Sets Nearest_Declarative_Part to the declarative part of Parent.
      --  Sets Stop to True to stop the search.

      procedure Set_Declarative_Part
        (Parent : Ada_Node;
         Stop   : in out Boolean) is
      begin
         Nearest_Declarative_Part := Get_Declarative_Part (Parent);
         Stop := True;
      end Set_Declarative_Part;

   begin
      Find_Matching_Parents
        (Node,
         Is_Declarative_Part_Owner'Access,
         Set_Declarative_Part'Access);

      return Nearest_Declarative_Part;
   end Get_Enclosing_Declarative_Part;

   ----------------------
   -- Get_Node_As_Name --
   ----------------------

   function Get_Node_As_Name (Node : Ada_Node)
                              return Name is
   begin
      if Node = No_Ada_Node
        or else Node.Kind not in Ada_Name
      then
         return No_Name;
      end if;

      return Node.As_Name;
   end Get_Node_As_Name;

   -------------------------------------
   -- Get_Package_Body_Declative_Part --
   -------------------------------------

   function Get_Package_Body_Declative_Part
     (Pkg_Body : Package_Body) return Declarative_Part is
   begin
      if Pkg_Body = No_Package_Body then
         return No_Declarative_Part;
      end if;

      return Pkg_Body.F_Decls;
   end Get_Package_Body_Declative_Part;

   ----------------------------
   -- Get_Package_Body_Decls --
   ----------------------------

   function Get_Package_Body_Decls (Pkg_Body : Package_Body)
      return Ada_Node_List is
   begin
      if Pkg_Body = No_Package_Body then
         return No_Ada_Node_List;
      end if;

      return Pkg_Body.F_Decls.F_Decls;
   end Get_Package_Body_Decls;

   ----------------------------------------
   -- Get_Package_Decl_Declarative_Parts --
   ----------------------------------------

   function Get_Package_Declarative_Parts
     (Pkg_Decl : Base_Package_Decl'Class)
      return Declarative_Part_Vectors.Vector
   is
      Decls : Declarative_Part_Vectors.Vector;

      --  A Base_Package_Decl always has a Public_Part but might not have a
      --  Private_Part or an associated Package_Body with a Declarative_Part.

      Private_Part : Declarative_Part;
      Body_Part    : Declarative_Part;
   begin
      if Pkg_Decl.Is_Null then
         return Decls;
      end if;

      Decls.Append (Get_Package_Decl_Public_Declarative_Part (Pkg_Decl));

      Private_Part := Get_Package_Decl_Private_Declarative_Part (Pkg_Decl);

      if Private_Part /= No_Declarative_Part then
         Decls.Append (Private_Part);
      end if;

      if Pkg_Decl.P_Body_Part /= No_Package_Body then
         Body_Part := Get_Package_Body_Declative_Part (Pkg_Decl.P_Body_Part);

         if Body_Part /= No_Declarative_Part then
            Decls.Append (Body_Part);
         end if;
      end if;

      return Decls;
   end Get_Package_Declarative_Parts;

   -----------------------
   -- Get_Package_Decls --
   -----------------------

   function Get_Package_Decls
     (Pkg_Decl : Base_Package_Decl'Class)
      return Ada_List_Vector is
   begin
      return Result : Ada_List_Vector do
         Append_If_Not_Null
           (Result, Get_Package_Decl_Public_Decls (Pkg_Decl));
         Append_If_Not_Null
           (Result, Get_Package_Decl_Private_Decls (Pkg_Decl));
         Append_If_Not_Null
           (Result, Get_Package_Body_Decls (Pkg_Decl.P_Body_Part));
      end return;
   end Get_Package_Decls;

   -----------------------------------------------
   -- Get_Package_Decl_Private_Declarative_Part --
   -----------------------------------------------

   function Get_Package_Decl_Private_Declarative_Part
     (Pkg_Decl : Base_Package_Decl'Class)
      return Declarative_Part is
   begin
      if Pkg_Decl.Is_Null or else Pkg_Decl.F_Private_Part.Is_Null then
         return No_Declarative_Part;
      end if;

      return Pkg_Decl.F_Private_Part.As_Declarative_Part;
   end Get_Package_Decl_Private_Declarative_Part;

   ------------------------------------
   -- Get_Package_Decl_Private_Decls --
   ------------------------------------

   function Get_Package_Decl_Private_Decls
     (Pkg_Decl : Base_Package_Decl'Class)
      return Ada_Node_List is
   begin
      if Pkg_Decl.Is_Null or else Pkg_Decl.F_Private_Part.Is_Null then
         return No_Ada_Node_List;
      end if;

      return Pkg_Decl.F_Private_Part.F_Decls;
   end Get_Package_Decl_Private_Decls;

   ----------------------------------------------
   -- Get_Package_Decl_Public_Declarative_Part --
   ----------------------------------------------

   function Get_Package_Decl_Public_Declarative_Part
     (Pkg_Decl : Base_Package_Decl'Class)
      return Declarative_Part is
   begin
      if Pkg_Decl.Is_Null then
         return No_Declarative_Part;
      end if;

      return Pkg_Decl.F_Public_Part.As_Declarative_Part;
   end Get_Package_Decl_Public_Declarative_Part;

   -----------------------------------
   -- Get_Package_Decl_Public_Decls --
   -----------------------------------

   function Get_Package_Decl_Public_Decls
     (Pkg_Decl : Base_Package_Decl'Class)
      return Ada_Node_List is
   begin
      if Pkg_Decl.Is_Null then
         return No_Ada_Node_List;
      end if;

      return Pkg_Decl.F_Public_Part.F_Decls;
   end Get_Package_Decl_Public_Decls;

   --------------------------
   -- Get_Param_Spec_Index --
   --------------------------

   function Get_Param_Spec_Index (Target : Param_Spec) return Positive
   is
      Index : Positive := 1;

   begin
      for Param_Spec of Target.Parent.As_Param_Spec_List loop
         if Param_Spec = Target then
            return Index;
         end if;

         Index := Index + 1;
      end loop;

      raise Program_Error with "Bug detected";
   end Get_Param_Spec_Index;

   ----------------------------------
   -- Get_Parameter_Absolute_Index --
   ----------------------------------

   function Get_Parameter_Absolute_Index
     (Target : Defining_Name)
      return Natural
   is
      Index : Positive := 1;

   begin
      for Param_Spec of
        Get_Subp_Params (Target.P_Parent_Basic_Decl).F_Params
      loop
         for Parameter of Param_Spec.F_Ids loop
            if Target = Parameter then
               return Index;
            end if;

            Index := Index + 1;
         end loop;
      end loop;

      raise Program_Error with "Bug detected";
   end Get_Parameter_Absolute_Index;

   ------------------------
   -- Get_Parameter_Name --
   ------------------------

   function Get_Parameter_Name
     (Parameters      : Params'Class;
      Parameter_Index : Positive)
      return Text_Type
   is
      Index  : Positive := 1;

   begin
      for Param_Spec of Parameters.F_Params loop
         for Parameter of Param_Spec.F_Ids loop
            if Index = Parameter_Index then
               return Parameter.As_Defining_Name.F_Name.Text;
            end if;

            Index := Index + 1;
         end loop;
      end loop;

      raise Assertion_Error;
   end Get_Parameter_Name;

   ------------------------
   -- Get_Parameter_Name --
   ------------------------

   function Get_Parameter_Name
     (Subp            : Basic_Decl'Class;
      Parameter_Index : Positive)
      return Text_Type
   is (Get_Parameter_Name (Get_Subp_Params (Subp), Parameter_Index));

   ------------------------------------
   -- Get_Subp_Body_Declarative_Part --
   ------------------------------------

   function Get_Subp_Body_Declarative_Part
     (Subp_B : Subp_Body) return Declarative_Part is
   begin
      if Subp_B = No_Subp_Body then
         return No_Declarative_Part;
      end if;

      return Subp_B.F_Decls;
   end Get_Subp_Body_Declarative_Part;

   -------------------------
   -- Get_Subp_Body_Decls --
   -------------------------

   function Get_Subp_Body_Decls
     (Subp_B : Subp_Body)
      return Ada_Node_List
   is (if Subp_B.Is_Null then No_Ada_Node_List else Subp_B.F_Decls.F_Decls);

   ---------------------
   -- Get_Subp_Params --
   ---------------------

   function Get_Subp_Params
     (Subp : Basic_Decl'Class)
      return Params is
     (Get_Subp_Spec_Params (Get_Subp_Spec (Subp)));

   -------------------
   -- Get_Subp_Spec --
   -------------------

   function Get_Subp_Spec (Subp : Basic_Decl'Class) return Base_Subp_Spec is
     (if Subp.Is_Null then No_Base_Subp_Spec
      else Subp.P_Subp_Spec_Or_Null (True));

   --------------------------
   -- Get_Subp_Spec_Params --
   --------------------------

   function Get_Subp_Spec_Params
     (Subp_Spec : Base_Subp_Spec'Class)
      return Params is
   begin
      if Subp_Spec.Is_Null then
         return No_Params;
      end if;

      case Ada_Base_Subp_Spec (Subp_Spec.Kind) is
         when Ada_Entry_Spec_Range
            => return Subp_Spec.As_Entry_Spec.F_Entry_Params;
         when Ada_Enum_Subp_Spec_Range
            => return No_Params;
         when Ada_Subp_Spec_Range
            => return Subp_Spec.As_Subp_Spec.F_Subp_Params;
         when Ada_Synthetic_Binary_Spec
            => return No_Params;
         when Ada_Synthetic_Unary_Spec
            => return No_Params;
      end case;
   end Get_Subp_Spec_Params;

   ------------------------------------
   -- Get_Task_Body_Declarative_Part --
   ------------------------------------

   function Get_Task_Body_Declarative_Part
     (Task_B : Task_Body) return Declarative_Part is
   begin
      if Task_B = No_Task_Body then
         return No_Declarative_Part;
      end if;

      return Task_B.F_Decls;
   end Get_Task_Body_Declarative_Part;

   -------------------------
   -- Get_Task_Body_Decls --
   -------------------------

   function Get_Task_Body_Decls
     (Task_B : Task_Body) return Ada_Node_List is
   begin
      if Task_B = No_Task_Body then
         return No_Ada_Node_List;
      end if;

      return Task_B.F_Decls.F_Decls;
   end Get_Task_Body_Decls;

   --------------------------------
   -- Get_Use_Units_Public_Parts --
   --------------------------------

   function Get_Use_Units_Public_Parts
     (Node : Ada_Node'Class)
      return Declarative_Part_Vector
   is
      Public_Parts : Declarative_Part_Vector;

      Node_Unit  : constant Compilation_Unit := Get_Compilation_Unit (Node);
      Used_Units : constant Compilation_Unit_Array :=
        Get_Used_Units (Node_Unit);

      procedure Process_Top_Level_Decl (TLD : Basic_Decl);
      --  Processes the top level declaration of a unit if it is a
      --  Base_Package_Decl, Generic_Package_Instantiation or a
      --  Package_Rename_Decl.
      --  Processes by getting the public part of the package, casting it
      --  as Declarative_Part and adding it to Declarative_Parts.
      --  This package can be recursive up to one time, i.e., it can call
      --  itself if TLD is a Package_Rename_Decl, but then it won't call
      --  itself again.

      ----------------------------
      -- Process_Top_Level_Decl --
      ----------------------------

      procedure Process_Top_Level_Decl (TLD : Basic_Decl) is
         --  Designated_Generic_Decl
         DGD : Basic_Decl;

      begin
         if not TLD.Is_Null then
            case TLD.Kind is
               when Ada_Base_Package_Decl =>
                  Public_Parts.Append (TLD.As_Base_Package_Decl.F_Public_Part);

               when Ada_Generic_Package_Instantiation_Range =>
                  --  If TLD is a Generic_Package_Instantiation then we need to
                  --  get its designated generic declaration, which can be
                  --  null.

                  DGD :=
                    TLD.As_Generic_Instantiation.P_Designated_Generic_Decl;

                  if not DGD.Is_Null
                    and then DGD.Kind in Ada_Generic_Package_Decl_Range
                  then
                     Public_Parts.Append
                       (DGD.As_Generic_Package_Decl.F_Package_Decl.
                          F_Public_Part.As_Declarative_Part);
                  end if;

               when Ada_Package_Renaming_Decl_Range =>
                  --  If TLD is a Package_Renaming_Decl, unwind the renames
                  --  the final declaration if reached. This will be a package
                  --  Decl, which can be considered as a TLD. Therefore,
                  --  call recursively call Process_Top_Level_Decl with the
                  --  final TLD.

                  Process_Top_Level_Decl
                    (TLD.As_Package_Renaming_Decl.P_Final_Renamed_Package);

               when others =>
                  raise Assertion_Error;
            end case;
         end if;
      end Process_Top_Level_Decl;

   begin
      for Used_Unit of Used_Units loop
         --  The array returned by Get_Used_Units does not contain null
         --  Compilation_Units, so it safe to try to get the top level
         --  declaration and process it.

         Process_Top_Level_Decl (Used_Unit.P_Decl);
      end loop;

      return Public_Parts;
   end Get_Use_Units_Public_Parts;

   --------------------
   -- Get_Used_Units --
   --------------------

   function Get_Used_Units
     (Node : Compilation_Unit'Class)
      return Compilation_Unit_Array
   is
      Used_Units : Compilation_Unit_Vectors.Vector;

   begin
      if Node.Is_Null then
         return [];
      end if;

      for Clause of Node.F_Prelude loop
         if Clause.Kind in Ada_Use_Package_Clause_Range then
            for Use_Clause of Clause.As_Use_Package_Clause.F_Packages loop
               declare
                  C_Unit : constant Compilation_Unit :=
                    Get_Compilation_Unit (Use_Clause.P_Referenced_Decl);
               begin
                  if not C_Unit.Is_Null then
                     Used_Units.Append (C_Unit);
                  end if;
               end;
            end loop;
         end if;
      end loop;

      --  Copy the Used_Units elements to an array

      return R : Compilation_Unit_Array
        (1 .. Integer (Used_Units.Length))
      do
         declare
            Idx : Positive := 1;

         begin
            for U of Used_Units loop
               R (Idx) := U;
               Idx := Idx + 1;
            end loop;
         end;
      end return;
   end Get_Used_Units;

   ----------------------
   -- Get_Withed_Units --
   ----------------------

   function Get_Withed_Units
     (Node : Compilation_Unit'Class)
      return Compilation_Unit_Array
   is
      Used_Units : Compilation_Unit_Vectors.Vector;

   begin
      if Node.Is_Null then
         return [];
      end if;

      for Clause of Node.F_Prelude loop
         if Clause.Kind in Ada_With_Clause_Range then
            for Use_Clause of Clause.As_With_Clause.F_Packages loop
               declare
                  C_Unit : constant Compilation_Unit :=
                    Get_Compilation_Unit (Use_Clause.P_Referenced_Decl);
               begin
                  if not C_Unit.Is_Null then
                     Used_Units.Append (C_Unit);
                  end if;
               end;
            end loop;
         end if;
      end loop;

      --  Copy the Used_Units elements to an array

      return R : Compilation_Unit_Array
        (1 .. Integer (Used_Units.Length))
      do
         declare
            Idx : Positive := 1;

         begin
            for U of Used_Units loop
               R (Idx) := U;
               Idx := Idx + 1;
            end loop;
         end;
      end return;
   end Get_Withed_Units;

   ------------
   -- Insert --
   ------------

   procedure Insert
     (Map     : in out Source_Location_Range_Map;
      Key     : String;
      Element : Source_Location_Range) is
   begin
      if Element = No_Source_Location_Range then
         return;
      end if;

      if Map.Contains (Key)
      then
         if not Map.Reference (Key).Contains (Element)
         then
            Map.Reference (Key).Insert (Element);
         end if;
      else
         declare
            S : Source_Location_Range_Set;
         begin
            S.Insert (Element);
            Map.Insert (Key, S);
         end;
      end if;
   end Insert;

   -------------------
   -- Is_Access_Ref --
   -------------------

   function Is_Access_Ref (Node : Ada_Node) return Boolean is
   begin
      if Node.Parent.Is_Null then
         return False;
      end if;

      if Node.Parent.Kind = Ada_Dotted_Name then
         return Is_Access_Ref (Node.Parent);
      end if;

      if Node.Parent.Kind in Ada_Name then
         declare
            Sibling : constant Ada_Node := Node.Next_Sibling;
            Text    : constant Wide_Wide_String :=
              (if Sibling.Is_Null
               then ""
               else Ada.Wide_Wide_Characters.Handling.To_Lower
                 (Sibling.Text));
         begin
            return
              Text = "access"
              or else Text = "unrestricted_access"
              or else Text = "unchecked_access"
              or else Text = "address";
         end;
      end if;
      return False;
   end Is_Access_Ref;

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

   function Is_Call
     (Node      : Ada_Node'Class;
      Trace     : GNATCOLL.Traces.Trace_Handle;
      Imprecise : in out Boolean) return Boolean is
   begin
      return Node.As_Ada_Node /= No_Ada_Node
        and then Node.Kind in Ada_Name
        and then Node.As_Name.P_Is_Call
        and then Node.Kind = Ada_Identifier
        and then not Is_Enum_Literal (Node, Trace, Imprecise);
   end Is_Call;

   -----------------
   -- Is_Constant --
   -----------------

   function Is_Constant (Node : Basic_Decl) return Boolean is
   begin
      for Child of Node.Children loop
         if Child /= No_Ada_Node
           and then Child.Kind = Ada_Constant_Present
         then
            return True;
         end if;
      end loop;

      return False;
   end Is_Constant;

   -------------------------------
   -- Is_Declarative_Part_Owner --
   -------------------------------

   function Is_Declarative_Part_Owner
     (Node : Ada_Node'Class)
      return Boolean
   is (not Node.Is_Null
       and then Node.Kind in
         Ada_Decl_Block_Range
         | Ada_Entry_Body_Range
         | Ada_Package_Body_Range
         | Ada_Protected_Body_Range
         | Ada_Subp_Body_Range
         | Ada_Subp_Decl_Range
         | Ada_Task_Body_Range
         | Ada_Base_Package_Decl
         | Ada_Protected_Def_Range
         | Ada_Task_Def_Range);

   ------------------------
   -- Is_Decl_Expr_Owner --
   ------------------------

   function Is_Decl_Expr_Owner
     (Node : Ada_Node'Class)
      return Boolean
   is (not Node.Is_Null
       and then Node.Kind in Ada_Expr_Function
       and then Node.As_Expr_Function.F_Expr.Kind in Ada_Paren_Expr_Range
       and then Node.As_Expr_Function.F_Expr.As_Paren_Expr.F_Expr.Kind in
         Ada_Decl_Expr_Range);

   ---------------------
   -- Is_Params_Owner --
   ---------------------

   function Is_Params_Owner
     (Node : Ada_Node'Class)
      return Boolean
   is (not Node.Is_Null
       and then ((Node.Kind in Ada_Basic_Decl
                  and then not Node.As_Basic_Decl.P_Subp_Spec_Or_Null.Is_Null
                  and then Node.As_Basic_Decl.P_Subp_Spec_Or_Null.Kind in
                             Ada_Subp_Spec_Range)
                 or else Node.Kind in
                           Ada_Entry_Decl_Range
                             | Ada_Accept_Stmt_Range
                             | Ada_Entry_Body_Range));

   ---------------------------
   -- Is_Whole_Line_Comment --
   ---------------------------

   function Is_Whole_Line_Comment
     (Token : Token_Reference)
      return Boolean is
   begin
      if Token /= No_Token
        and then Kind (Data (Token)) in Ada_Comment
        and then Sloc_Range (Data (Token)).Start_Line > 0
      then
         declare
            use Ada.Strings.Wide_Wide_Fixed;

            Token_Line_Number   : constant Positive :=
              Positive (Sloc_Range (Data (Token)).Start_Line);
            Token_Column_Number : constant Positive :=
              Positive (Sloc_Range (Data (Token)).Start_Column);
            Token_Line          : constant Text_Type :=
              Unit (Token).Get_Line (Token_Line_Number);

            First_Non_Blank_Character_Index : constant Positive :=
              Index_Non_Blank (Token_Line) - Token_Line'First + 1;
         begin
            return First_Non_Blank_Character_Index = Token_Column_Number;
         end;
      else
         return False;
      end if;
   end Is_Whole_Line_Comment;

   ---------------------------------------------------
   -- Is_Definition_Without_Separate_Implementation --
   ---------------------------------------------------

   function Is_Definition_Without_Separate_Implementation
     (Definition : Defining_Name) return Boolean
   is
      Parents : constant Ada_Node_Array := Definition.Parents;
   begin
      return Parents'Length > 2 and then Parents (Parents'First + 2).Kind in
        Ada_Abstract_Subp_Decl
      --  This is as abstract subprogram
        | Ada_Null_Subp_Decl
      --  This is an "is null" procedure
        | Ada_Expr_Function;
      --  This is an expression function
   end Is_Definition_Without_Separate_Implementation;

   ---------------------
   -- Is_Enum_Literal --
   ---------------------

   function Is_Enum_Literal
     (Node      : Ada_Node'Class;
      Trace     : GNATCOLL.Traces.Trace_Handle;
      Imprecise : in out Boolean) return Boolean
   is
      Definition     : Defining_Name;
      This_Imprecise : Boolean := False;
   begin
      if Node.As_Ada_Node /= No_Ada_Node
        and then Node.Kind in Ada_Name
      then
         Definition := Laltools.Common.Resolve_Name
           (Node.As_Name, Trace, This_Imprecise);
         Imprecise := Imprecise or This_Imprecise;
         return Definition /= No_Defining_Name
           and then Definition.P_Basic_Decl.Kind =
             Ada_Enum_Literal_Decl;
      end if;

      return False;
   end Is_Enum_Literal;

   ------------------
   -- Is_Renamable --
   ------------------

   function Is_Renamable (Node : Ada_Node'Class) return Boolean is
      Node_Name : constant Libadalang.Analysis.Name
        := Get_Node_As_Name (Node.As_Ada_Node);
   begin
      --  Only consider renamable if a precise definition is found
      return Node_Name /= No_Name and then
        (Node_Name.P_Is_Defining or else
         Node.As_Name.P_Referenced_Defining_Name (Imprecise_Fallback => False)
         /= No_Defining_Name);
   end Is_Renamable;

   ------------------
   -- Is_Structure --
   ------------------

   function Is_Structure (Node : Basic_Decl) return Boolean is
   begin
      for Child of Node.Children loop
         if Child /= No_Ada_Node
           and then Child.Kind = Ada_Record_Type_Def
         then
            return True;
         end if;
      end loop;

      return False;
   end Is_Structure;

   ------------
   -- Length --
   ------------

   function Length (List : Assoc_List) return Natural
   is
      L : Natural := 0;
   begin
      for Node of List loop
         L := L + 1;
      end loop;

      return L;
   end Length;

   ------------
   -- Length --
   ------------

   function Length (List : Compilation_Unit_List) return Natural
   is
      L : Natural := 0;
   begin
      for Unit of List loop
         L := L + 1;
      end loop;

      return L;
   end Length;

   ------------
   -- Length --
   ------------

   function Length (List : Defining_Name_List) return Natural
   is
      L : Natural := 0;
   begin
      for Node of List loop
         L := L + 1;
      end loop;

      return L;
   end Length;

   ------------
   -- Length --
   ------------

   function Length (List : Param_Spec_List) return Natural
   is
      L : Natural := 0;
   begin
      for Node of List loop
         L := L + 1;
      end loop;

      return L;
   end Length;

   --------------------
   -- List_Bodies_Of --
   --------------------

   function List_Bodies_Of
     (Definition         : Defining_Name;
      Trace              : GNATCOLL.Traces.Trace_Handle;
      Imprecise          : in out Boolean)
      return Bodies_List.List
   is
      List       : Bodies_List.List;
      Next_Part  : Defining_Name;
      Loop_Count : Natural := 0;
      Parents    : constant Ada_Node_Array := Definition.Parents;
   begin
      --  If this happens to be the definition of a subprogram that
      --  does not call for a body, let's consider that this *is* the
      --  implementation. Return this, and do not attempt to look
      --  for secondary implementations in this case.
      if Parents'Length > 2 and then Parents (Parents'First + 2).Kind in
        Libadalang.Common.Ada_Null_Subp_Decl     --  "is null" procedure?
          | Libadalang.Common.Ada_Expr_Function  --  expression function?
      then
         List.Append (Definition);
         return List;
      end if;

      --  If the definition that we found is a subprogram body, add this to the
      --  list
      if Parents'Length > 2 and then Parents (Parents'First + 2).Kind in
        Libadalang.Common.Ada_Subp_Body
      then
         List.Append (Definition);
      end if;

      --  TODO: Reactivate these lines when libadalang supports
      --  P_Next_Part for tasks: T716-049
      --  if Parents'Length > 1 and then Parents (Parents'First + 1).Kind in
      --    Libadalang.Common.Ada_Task_Body
      --  then
      --     List.Append (Definition);
      --  end if;

      Next_Part := Definition;

      --  Now that we have a definition, list all the implementations for
      --  this definition. We do this by iterating on Find_Next_Part
      loop
         --  Safety net, don't rely on the results making sense, since
         --  the code might be invalid.
         Next_Part := Laltools.Common.Find_Next_Part (Next_Part, Trace);

         exit when Next_Part = No_Defining_Name;

         List.Append (Next_Part);

         Loop_Count := Loop_Count + 1;
         if Loop_Count > 5 then
            Imprecise := True;
            exit;
         end if;
      end loop;
      return List;
   end List_Bodies_Of;

   ---------
   -- Log --
   ---------

   procedure Log
     (Trace   : GNATCOLL.Traces.Trace_Handle;
      E       : Ada.Exceptions.Exception_Occurrence;
      Message : String := "") is
   begin
      if Message /= "" then
         Trace.Trace (Message);
      end if;

      Trace.Trace (Ada.Exceptions.Exception_Name (E)
                   & ": "
                   & Ada.Exceptions.Exception_Message (E)
                   & ASCII.LF
                   & GNAT.Traceback.Symbolic.Symbolic_Traceback (E));
   end Log;

   -----------
   -- Merge --
   -----------

   procedure Merge
     (Left  : in out Source_Location_Range_Map;
      Right : Source_Location_Range_Map)
   is
      Map_Cursor : Source_Location_Range_Maps.Cursor := Right.First;

   begin
      while Source_Location_Range_Maps.Has_Element (Map_Cursor) loop
         if Left.Contains (Source_Location_Range_Maps.Key (Map_Cursor)) then
            declare
               Set_Cursor : Source_Location_Range_Sets.Cursor :=
                 Right.Constant_Reference (Map_Cursor).First;

            begin
               while Source_Location_Range_Sets.Has_Element (Set_Cursor) loop
                  Left.Reference (Source_Location_Range_Maps.Key (Map_Cursor))
                    .Insert (Source_Location_Range_Sets.Element (Set_Cursor));
                  Source_Location_Range_Sets.Next (Set_Cursor);
               end loop;
            end;

         else
            Left.Insert
              (Source_Location_Range_Maps.Key (Map_Cursor),
               Source_Location_Range_Maps.Element (Map_Cursor));
         end if;

         Source_Location_Range_Maps.Next (Map_Cursor);
      end loop;
   end Merge;

   ------------------
   -- Resolve_Name --
   ------------------

   function Resolve_Name
     (Name_Node : Name;
      Trace     : GNATCOLL.Traces.Trace_Handle;
      Imprecise : out Boolean) return Defining_Name
   is
      Result : Defining_Name;
      Failsafe_Result : Refd_Def;
   begin
      Imprecise := False;

      if Name_Node.Is_Null then
         return No_Defining_Name;
      --  P_Failsafe_Referenced_Def_Name doesn't work on the decl itself
      elsif Name_Node.P_Is_Defining then
         Result := Name_Node.P_Enclosing_Defining_Name.P_Canonical_Part;
      else
         Failsafe_Result := Name_Node.P_Failsafe_Referenced_Def_Name
           (Imprecise_Fallback => True);
         case Kind (Failsafe_Result) is
            when Precise =>
            --  Nothing extra to do here
               null;
            when Libadalang.Common.Imprecise =>
               Imprecise := True;
            when Error =>
               Imprecise := True;
               return No_Defining_Name;
            when No_Ref =>
               return No_Defining_Name;
         end case;

         Result := Defining_Name (Def_Name (Failsafe_Result));

         if Result /= No_Defining_Name then
            Result := Result.P_Canonical_Part;
         end if;
      end if;

      return Result;

   exception
      when E : Property_Error =>
         Log (Trace, E);
         Imprecise := True;
         return No_Defining_Name;
   end Resolve_Name;

   ----------------------------
   -- Resolve_Name_Precisely --
   ----------------------------

   function Resolve_Name_Precisely (Name_Node : Name) return Defining_Name is
   begin
      if Name_Node = No_Name then
         return No_Defining_Name;
      end if;

      --  P_Referenced_Defining_Name doesn't work on the decl itself
      if Name_Node.P_Is_Defining then
         return Name_Node.P_Enclosing_Defining_Name.P_Canonical_Part;
      else
         return Result : Defining_Name :=
           Name_Node.P_Referenced_Defining_Name (Imprecise_Fallback => False)
         do
            if Result /= No_Defining_Name then
               Result := Result.P_Canonical_Part;
            end if;
         end return;
      end if;
   end Resolve_Name_Precisely;

   ---------------------
   -- Validate_Syntax --
   ---------------------

   function Validate_Syntax
     (Source : Ada.Strings.Unbounded.Unbounded_String;
      Rule   : Grammar_Rule)
      return Boolean
   is
      Unit : constant Analysis_Unit :=
        Create_Context.Get_From_Buffer
          (Filename => "", Buffer => Source, Rule => Rule);

   begin
      return not Unit.Has_Diagnostics;
   end Validate_Syntax;

   ---------------------
   -- Validate_Syntax --
   ---------------------

   function Validate_Syntax
     (Source : Ada.Strings.Unbounded.Unbounded_String;
      Rules  : Grammar_Rule_Vector)
      return Boolean
   is ((for some Rule of Rules => Validate_Syntax (Source, Rule)));

end Laltools.Common;