lal_refactor_25.0.0_15241508/src/lal_refactor-tools-suppress_dead_params_tool.adb

--
--  Copyright (C) 2022-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

with Langkit_Support.Errors;
with Libadalang.Common;
with Ada.Containers.Vectors;
with Ada.Strings;
with Ada.Characters.Latin_1;
with Langkit_Support.Text;
with LAL_Refactor.Subprogram_Signature;
with LAL_Refactor.Subprogram_Signature.Remove_Parameter;
with LAL_Refactor.Output;

package body LAL_Refactor.Tools.Suppress_Dead_Params_Tool is
   package LALCO renames Libadalang.Common;
   package Text renames Langkit_Support.Text;

   package Range_Vectors is new Ada.Containers.Vectors
     (Index_Type   => Positive,
      Element_Type => ReFac.Subprogram_Signature.Parameter_Indices_Range_Type,
      "="          => ReFac.Subprogram_Signature."="
     );

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

   function "<" (L, R : LAL.Defining_Name) return Boolean is
   begin
      if L.Unit.Get_Filename < R.Unit.Get_Filename then
         return True;
      else
         if L.Unit.Get_Filename > R.Unit.Get_Filename then
            return False;
         else
            return (Start_Sloc (LAL.Sloc_Range (L)) <
                      Start_Sloc (LAL.Sloc_Range (R)));
         end if;
      end if;
   end "<";

   ------------------------
   -- Find_Useless_Param --
   ------------------------

   function Find_Dead_Param (Unit_Array : LAL.Analysis_Unit_Array)
                             return Edit_Infos is
      Any_Value : constant Value := (Fixed => False);
      Vals : Values.Map;
      Edit_Infos : Subp_Spec_To_Edit_Text.Map;
      Subpspec_To_Param : Subp_Spec_To_Defining_Names_Set.Map;

      procedure Add_Value
        (S : LAL.Subp_Spec;
         N : LAL.Defining_Name;
         E : LAL.Enum_Literal_Decl);
      --  Add the called value to the relative subprogram

      procedure Add_Any_Value
        (S : LAL.Subp_Spec;
         N : LAL.Defining_Name);
      --  Erase any fixed enumeration value associated to N

      procedure Safe_Insert
        (Params : in out Defining_Name_Ordered_Sets.Set;
         Param  : LAL.Defining_Name);
      --  Insert Removable Parameter's name to the Set

      procedure Safe_Insert
        (Edits     : in out Subp_Spec_To_Defining_Names_Set.Map;
         Func_Name : LAL.Subp_Spec;
         Param     : LAL.Defining_Name);
      --  Insert Removable Parameter's name to the Map

      procedure Visit_Subp_Spec (Node : LAL.Subp_Spec);
      --  Handle a subprogram spec for the canonical declaration of a
      --  subprogram, which can be its spec or its body. For every default
      --  value of a parameter of an enumeration type, consider that there is
      --  a call with that default value, and treat it similarly.

      function Find_Subprogram (Node : LAL.Ada_Node'Class)
                                return LALCO.Visit_Status;
      --  travers all the AST and find out all the Supb_Spec

      function Get_Enumeration_Literal (Node : LAL.Expr'Class)
                                        return LAL.Enum_Literal_Decl;
      --  if the subprogram is called by a enumerate type, return it.

      procedure Generate_Edits (Func_Name : LAL.Subp_Spec);

      --  Value E was observed for parameter N

      ---------------
      -- Add_Value --
      ---------------

      procedure Add_Value
        (S : LAL.Subp_Spec;
         N : LAL.Defining_Name;
         E : LAL.Enum_Literal_Decl) is
         V : constant Value := (True, E);
         C : Values.Cursor;
         R : Boolean;
      begin
         Vals.Insert (Key => N, New_Item => V, Position => C, Inserted => R);
         Safe_Insert (Subpspec_To_Param, S, N);
         if not R
           and then Vals (C) /= V
         then
            Vals.Include (Key => N, New_Item => Any_Value);
            if Subpspec_To_Param.Contains (S) then
               Subpspec_To_Param (S).Exclude (N);
            end if;
         end if;
      end Add_Value;

      -------------------
      -- Add_Any_Value --
      -------------------

      procedure Add_Any_Value
        (S : LAL.Subp_Spec;
         N : LAL.Defining_Name)
      is
      begin
         Vals.Include (Key => N, New_Item => Any_Value);
         if Subpspec_To_Param.Contains (S) then
            Subpspec_To_Param (S).Exclude (N);
         end if;
      end Add_Any_Value;

      -----------------
      -- Safe_Insert --
      -----------------

      procedure Safe_Insert
        (Params : in out Defining_Name_Ordered_Sets.Set;
         Param  : LAL.Defining_Name) is
      begin
         if not Params.Contains (Param) then
            Params.Insert (Param);
         end if;
      end Safe_Insert;

      -----------------
      -- Safe_Insert --
      -----------------

      procedure Safe_Insert
        (Edits     : in out Subp_Spec_To_Defining_Names_Set.Map;
         Func_Name : LAL.Subp_Spec;
         Param     : LAL.Defining_Name) is
         Edits_Set : Defining_Name_Ordered_Sets.Set;
      begin
         if Edits.Contains (Func_Name) then
            Safe_Insert (Edits.Reference (Func_Name), Param);

         else
            Edits_Set.Insert (Param);
            Edits.Insert (Func_Name, Edits_Set);
         end if;
      end Safe_Insert;

      -----------------------------
      -- Get_Enumeration_Literal --
      -----------------------------

      function Get_Enumeration_Literal (Node : LAL.Expr'Class)
                                        return LAL.Enum_Literal_Decl is
      begin
         if Node.Kind in LALCO.Ada_Identifier_Range
         and then not Node.As_Identifier.P_Referenced_Decl.Is_Null
         and then Node.As_Identifier.P_Referenced_Decl.Kind
                   in LALCO.Ada_Enum_Literal_Decl_Range
         then
            return Node.As_Identifier.P_Referenced_Decl.As_Enum_Literal_Decl;
         else
            return LAL.No_Enum_Literal_Decl;
         end if;
      end Get_Enumeration_Literal;

      ---------------------
      -- Visit_Subp_Spec --
      ---------------------

      procedure Visit_Subp_Spec (Node : LAL.Subp_Spec) is
      begin
         if not Node.As_Subp_Spec.F_Subp_Params.Is_Null then
            declare
               Params : constant LAL.Param_Spec_List :=
                 Node.As_Subp_Spec.F_Subp_Params.F_Params;
            begin
               for Param of Params loop
                  declare
                     Default : constant LAL.Expr'Class :=
                       Param.As_Param_Spec.F_Default_Expr;
                  begin
                     if not Default.Is_Null then
                        if not Get_Enumeration_Literal (Default).Is_Null then
                           for P of Param.As_Param_Spec.F_Ids loop
                              Add_Value (Node,
                                         P.As_Defining_Name,
                                         Get_Enumeration_Literal (Default));
                           end loop;
                        elsif not Default.P_Expression_Type.Is_Null
                          and then Default.P_Expression_Type.P_Is_Enum_Type
                        then
                           for P of Param.As_Param_Spec.F_Ids loop
                              Add_Any_Value (Node, P.As_Defining_Name);
                           end loop;
                        end if;
                     end if;
                  end;
               end loop;
            end;
         end if;
      end Visit_Subp_Spec;

      -----------
      -- Visit --
      -----------

      function Find_Subprogram  (Node : LAL.Ada_Node'Class)
                                 return LALCO.Visit_Status is
      begin
         case Node.Kind is
         when LALCO.Ada_Subp_Spec_Range =>
            if Node.Parent.Kind not in LALCO.Ada_Subp_Body_Range then
               Visit_Subp_Spec (Node.As_Subp_Spec);
            end if;
         when LALCO.Ada_Call_Expr =>
            declare
               Call : constant LAL.Call_Expr'Class := Node.As_Call_Expr;
            begin
               if Call.F_Suffix.Kind in LALCO.Ada_Assoc_List_Range then
                  declare
                     Params : constant LAL.Param_Actual_Array :=
                       Call.F_Suffix.As_Assoc_List.P_Zip_With_Params;
                  begin
                     for Pair of Params loop
                        declare
                           P : constant LAL.Defining_Name'Class :=
                             LAL.Param (Pair).P_Canonical_Part;
                           A : constant LAL.Expr'Class := LAL.Actual (Pair);
                        begin
                           if not Get_Enumeration_Literal (A).Is_Null then
                              Add_Value (Call.P_Called_Subp_Spec.As_Subp_Spec,
                                         P.As_Defining_Name
                                         , Get_Enumeration_Literal (A));
                           elsif P.F_Name.P_Is_Constant
                           then
                              Add_Value (Call.P_Called_Subp_Spec.As_Subp_Spec,
                                         P.As_Defining_Name,
                                         P.As_Defining_Name.F_Name
                                         .P_Referenced_Decl
                                         .As_Object_Decl.F_Default_Expr
                                         .As_Enum_Literal_Decl);
                           elsif not A.P_Expression_Type.Is_Null
                             and then A.P_Expression_Type.P_Is_Enum_Type
                           then
                              Add_Any_Value (Call.P_Called_Subp_Spec
                                             .As_Subp_Spec,
                                             P.As_Defining_Name);
                           end if;
                        end;
                     end loop;
                  end;
               end if;
            exception
                  --  due to null dereference during P_Zip_With_Params
                  --  as well as timeout
               when Langkit_Support.Errors.Property_Error => null;
            end;

         when others =>
            null;
         end case;
         return LALCO.Into;
      end Find_Subprogram;

      --------------------
      -- Generate_Edits --
      --------------------

      procedure Generate_Edits (Func_Name : LAL.Subp_Spec) is
         Param_Removable : constant Defining_Name_Ordered_Sets.Set :=
           Subpspec_To_Param (Func_Name);
         Param_Indices   : Range_Vectors.Vector;
         Params          : constant LAL.Param_Spec_Array :=
           Func_Name.P_Params;
         Flag            : Boolean := False;
         First, Last     : Positive := 1;
         Indice_Range    : ReFac.Subprogram_Signature.
           Parameter_Indices_Range_Type;
         Father          : constant LAL.Ada_Node := Func_Name.Parent;

         function Generate_Constant return ReFac.Text_Edit;
         --  generate the text_edit for each dead parameters

         -----------------------
         -- Generate_Constant --
         -----------------------

         function Generate_Constant return ReFac.Text_Edit is
            Define_Text : Ada.Strings.Unbounded.Unbounded_String :=
              Ada.Strings.Unbounded.Null_Unbounded_String;
            Text_Edit : ReFac.Text_Edit;
            Position : constant Source_Location_Range := Func_Name.Sloc_Range;

            procedure Generate_Text;
            --  generate the declaration of the dead parameters

            -------------------
            -- Generate_Text --
            -------------------

            procedure Generate_Text is
            begin
               for Param of Param_Removable loop
                  Define_Text := Define_Text
                    & Text.Image (Param.P_Basic_Decl.Text);
                  if Param.P_Basic_Decl.As_Param_Spec.F_Default_Expr.Is_Null
                  then
                     Define_Text := Define_Text & " := "
                       & Text.Image (Vals (Param).V.Text);
                  end if;
                  Define_Text := Define_Text & ";";
               end loop;
               Define_Text := Define_Text & Ada.Characters.Latin_1.LF;
            end Generate_Text;
         begin
            if Father.Kind in LALCO.Ada_Subp_Body_Range then
               Text_Edit.Location.Start_Column := Position.Start_Column + 3;
               Text_Edit.Location.End_Column := Position.Start_Column + 3;
               Text_Edit.Location.Start_Line := Father.As_Subp_Body.F_Decls
                 .Sloc_Range.Start_Line + 1;
               Text_Edit.Location.End_Line := Father.As_Subp_Body.F_Decls
                 .Sloc_Range.Start_Line + 1;
               Generate_Text;
               Text_Edit.Text := Define_Text;
            else
               Text_Edit.Location := Father.As_Expr_Function
                 .F_Expr.Children (1).Sloc_Range;
               Generate_Text;
               Text_Edit.Text := "(declare " & Define_Text & "begin "
                 & Text.Image
                 (Father.As_Expr_Function.F_Expr.Children (1).Text)
                 & ")";
            end if;
            return Text_Edit;
         end Generate_Constant;
      begin
         for I_Param in Params'Range loop
            if Param_Removable.Contains (Params (I_Param).P_Defining_Name) then
               Last := I_Param;
               Flag := True;
            else
               if Flag then
                  Indice_Range := (First, Last);
                  Param_Indices.Append (Indice_Range);
                  Flag := False;
               end if;
               First := I_Param + 1;
            end if;
         end loop;
         if Flag then
            Indice_Range := (First, Last);
            Param_Indices.Append (Indice_Range);
         end if;
         if not Param_Indices.Is_Empty then
            declare
               Indice_Array : ReFac.Subprogram_Signature
                 .Parameter_Indices_Ranges_Type
                   (1 .. Param_Indices.Last_Index);
               Edit_Info : ReFac.Text_Edit_Map;
            begin
               for I in 1 .. Param_Indices.Last_Index loop
                  Indice_Array (I) := Param_Indices (I);
               end loop;
               Edit_Info := ReFac.Subprogram_Signature.Remove_Parameter
                 .Remove_Parameters (Func_Name.P_Parent_Basic_Decl,
                                     Indice_Array,
                                     Unit_Array);
               if Father.Kind not in LALCO.Ada_Subp_Decl_Range then
                  ReFac.Safe_Insert (Edit_Info, Func_Name.Unit.Get_Filename,
                                  Generate_Constant);
               end if;
               Edit_Infos.Insert (Func_Name, Edit_Info);
            end;
         end if;
      end Generate_Edits;
   begin
      for Unit of Unit_Array loop
         Unit.Root.Traverse (Find_Subprogram'Access);
      end loop;
      for Subp_Name in Subpspec_To_Param.Iterate loop
         --  Put_Line (Text.Image (Subp_Name.Key.Text));
         --  for Param of Subpspec_To_Param (Subp_Name) loop
         --     Put_Line (Text.Image (Param.Text));
         --  end loop;
         Generate_Edits (Subp_Name.Key);
      end loop;
      return (Edit_Infos, Subpspec_To_Param);
   end Find_Dead_Param;

   ---------
   -- Run --
   ---------

   procedure Run
     (Unit_Array : LAL.Analysis_Unit_Array;
      Stream     : in out VSS.Text_Streams.Output_Text_Stream'Class)
   is
      Edit_Info : Edit_Infos;

   begin
      Edit_Info := Find_Dead_Param (Unit_Array);
      LAL_Refactor.Output.JSON_Serialize (Edit_Info, Stream);
   end Run;

end LAL_Refactor.Tools.Suppress_Dead_Params_Tool;