remove unused modules and types

Author: zth

compiler/ml/cmt_utils.ml

@@ -13,6 +13,8 @@ type action_type =
   | RewriteIdent of {new_ident: Longident.t}
   | PrefixVariableWithUnderscore
   | RemoveUnusedVariable
+  | RemoveUnusedType
+  | RemoveUnusedModule
 
 (* TODO: 
 - Unused var in patterns (and aliases )*)
@@ -36,6 +38,8 @@ let action_to_string = function
     Printf.sprintf "RewriteIdentToModule(%s)" module_name
   | PrefixVariableWithUnderscore -> "PrefixVariableWithUnderscore"
   | RemoveUnusedVariable -> "RemoveUnusedVariable"
+  | RemoveUnusedType -> "RemoveUnusedType"
+  | RemoveUnusedModule -> "RemoveUnusedModule"
   | ReplaceWithVariantConstructor {constructor_name} ->
     Printf.sprintf "ReplaceWithVariantConstructor(%s)"
       (constructor_name |> Longident.flatten |> String.concat ".")
@@ -69,6 +73,16 @@ let emit_possible_actions_from_warning loc w =
         action = RemoveUnusedVariable;
         description = "Remove unused variable";
       }
+  | Unused_type_declaration _ ->
+    add_possible_action
+      {loc; action = RemoveUnusedType; description = "Remove unused type"}
+  | Unused_module _ ->
+    add_possible_action
+      {loc; action = RemoveUnusedModule; description = "Remove unused module"}
+  | Unused_pat -> (* TODO: Remove full pattern. *) ()
+  | Unused_argument ->
+    (* TODO(actions) Remove unused argument or prefix with underscore *) ()
+  | Unused_rec_flag -> (* TODO(actions) Remove unused rec flag *) ()
   | _ -> ()
 
 let _ =

compiler/ml/env.ml

@@ -1638,9 +1638,7 @@ and store_type ~check id info env =
   let loc = info.type_loc in
   if check then
     check_usage loc id
-      (fun s ->
-        (* TODO(actions) Remove unused type *)
-        Warnings.Unused_type_declaration s)
+      (fun s -> Warnings.Unused_type_declaration s)
       type_declarations;
   let path = Pident id in
   let constructors = Datarepr.constructors_of_type path info in
@@ -1722,11 +1720,7 @@ and store_extension ~check id ext env =
 and store_module ~check id md env =
   let loc = md.md_loc in
   if check then
-    check_usage loc id
-      (fun s ->
-        (* TODO(actions) Remove unused module *)
-        Warnings.Unused_module s)
-      module_declarations;
+    check_usage loc id (fun s -> Warnings.Unused_module s) module_declarations;
 
   let deprecated = Builtin_attributes.deprecated_of_attrs md.md_attributes in
   {

compiler/ml/parmatch.ml

@@ -2211,7 +2211,6 @@ let check_unused pred casel =
              |> List.filter (fun p ->
                     not (Variant_type_spread.is_pat_from_variant_spread_attr p))
              |> List.iter (fun p ->
-                    (* TODO(actions) Remove unused pattern or replace with _ *)
                     Location.prerr_warning p.pat_loc Warnings.Unused_pat)
            | Used -> ()
          with Empty | Not_found | NoGuard -> assert false);

compiler/ml/typecore.ml

@@ -1770,12 +1770,8 @@ let type_pattern ~lev env spat scope expected_ty =
   let pat = type_pat ~allow_existentials:true ~lev new_env spat expected_ty in
   let new_env, unpacks =
     add_pattern_variables !new_env
-      ~check:(fun s ->
-        (* TODO(actions) Remove unused variable or prefix with underscore *)
-        Warnings.Unused_var_strict s)
-      ~check_as:(fun s ->
-        (* TODO(actions) Remove unused variable or prefix with underscore *)
-        Warnings.Unused_var s)
+      ~check:(fun s -> Warnings.Unused_var_strict s)
+      ~check_as:(fun s -> Warnings.Unused_var s)
   in
   (pat, new_env, get_ref pattern_force, unpacks)
 
@@ -3661,7 +3657,6 @@ and type_application ~context total_app env funct (sargs : sargs) :
           so the function type including arity can be inferred. *)
           let t1 = newvar () and t2 = newvar () in
           if ty_fun.level >= t1.level && not_identity funct.exp_desc then
-            (* TODO(actions) Remove unused argument or prefix with underscore *)
             Location.prerr_warning sarg1.pexp_loc Warnings.Unused_argument;
           unify env ty_fun
             (newty
@@ -4227,7 +4222,6 @@ and type_let ~context ?(check = fun s -> Warnings.Unused_var s)
      let {pvb_pat; pvb_attributes} = List.hd spat_sexp_list in
      (* See PR#6677 *)
      Builtin_attributes.warning_scope ~ppwarning:false pvb_attributes (fun () ->
-         (* TODO(actions) Remove unused rec flag *)
          Location.prerr_warning pvb_pat.ppat_loc Warnings.Unused_rec_flag));
   List.iter2
     (fun pat (attrs, exp) ->

tests/build_tests/actions/expected/Actions_RemoveUnusedModule_applied.res

@@ -0,0 +1,6 @@
+// actionFilter=RemoveUnusedModule
+module M: {} = {}
+
+/* === AVAILABLE ACTIONS:
+- RemoveUnusedModule - Remove unused module
+*/

tests/build_tests/actions/expected/Actions_RemoveUnusedType_applied.res

@@ -0,0 +1,6 @@
+// actionFilter=RemoveUnusedType
+module M: {} = {}
+
+/* === AVAILABLE ACTIONS:
+- RemoveUnusedType - Remove unused type
+*/

tests/build_tests/actions/fixtures/Actions_RemoveUnusedModule.res

@@ -0,0 +1,6 @@
+// actionFilter=RemoveUnusedModule
+module M: {} = {
+  module N = {
+    let x = 12
+  }
+}

tests/build_tests/actions/fixtures/Actions_RemoveUnusedType.res

@@ -0,0 +1,4 @@
+// actionFilter=RemoveUnusedType
+module M: {} = {
+  type t = int
+}

tools/src/tools.ml

@@ -1316,6 +1316,31 @@ module Actions = struct
                        match remove_open_action with
                        | Some _ -> None
                        | None -> Some str_item)
+                     | Pstr_type (_, _type_declarations) -> (
+                       let remove_unused_type_action =
+                         actions
+                         |> List.find_opt
+                              (fun (action : Cmt_utils.cmt_action) ->
+                                match action.action with
+                                | RemoveUnusedType ->
+                                  action.loc = str_item.pstr_loc
+                                | _ -> false)
+                       in
+                       match remove_unused_type_action with
+                       | Some _ -> None
+                       | None -> Some str_item)
+                     | Pstr_module {pmb_loc} ->
+                       let remove_unused_module_action_locs =
+                         List.filter_map
+                           (fun (action : Cmt_utils.cmt_action) ->
+                             match action.action with
+                             | RemoveUnusedModule -> Some action.loc
+                             | _ -> None)
+                           actions
+                       in
+                       if List.mem pmb_loc remove_unused_module_action_locs then
+                         None
+                       else Some str_item
                      | _ -> Some str_item)
             in
             let items = Ast_mapper.default_mapper.structure mapper items in
@@ -1606,7 +1631,9 @@ module Actions = struct
                  | PrefixVariableWithUnderscore ->
                    List.mem "PrefixVariableWithUnderscore" filter
                  | RemoveUnusedVariable ->
-                   List.mem "RemoveUnusedVariable" filter)
+                   List.mem "RemoveUnusedVariable" filter
+                 | RemoveUnusedType -> List.mem "RemoveUnusedType" filter
+                 | RemoveUnusedModule -> List.mem "RemoveUnusedModule" filter)
       in
       match applyActionsToFile path possible_actions with
       | Ok applied ->