Add config for reporting transitively dead things. (#601)

* Add config for reporting transitively dead things.

This is the normal behaviour: no change.
When turned off, only the top dead things, and not the transitive ones, are reported.

* Turn off the flag for reporting transitive dead things.

* Comment.

* Do not report empty modules when transitive reporting is off.

As the only way for a module to be dead would be for it to be empty.

* Make transitive reports configurable.

* Restore default behaviour in tests.

* comment

* Update CHANGELOG.md

Author: cristianoc

Diff for: CHANGELOG.md

@@ -12,6 +12,11 @@
 
 ## master
 
+#### :rocket: New Feature
+
+- Add configuration parameter `"transitive"` under `"reanalyze"` is `bsconfig.json`. If set to `false`, the analysis does not report transitively dead items. So removing the reported item individually can be done in isolation. This is a more fine-grained process for guiding the user to remove dead code one item at a time. https://github.com/rescript-lang/rescript-vscode/pull/601
+This feature comes from a conversation with @jfmengels on how https://github.com/jfmengels/elm-review is designed.
+
 #### :bug: Bug Fix
 
 - Fix issue where module paths in `-open` in `bsc-flags` such as "-open ReScriptJs.Js" were not recognized https://github.com/rescript-lang/rescript-vscode/issues/607

Diff for: analysis/reanalyze/examples/deadcode/bsconfig.json

@@ -2,7 +2,8 @@
   "reanalyze": {
     "analysis": ["dce"],
     "suppress": [],
-    "unsuppress": []
+    "unsuppress": [],
+    "transitive": true
   },
   "name": "sample-typescript-app",
   "bsc-flags": ["-bs-super-errors -w a"],

Diff for: analysis/reanalyze/src/Common.ml

@@ -197,7 +197,7 @@ type decl = {
   pos: Lexing.position;
   posEnd: Lexing.position;
   posStart: Lexing.position;
-  mutable resolved: bool;
+  mutable resolvedDead: bool option;
   mutable report: bool;
 }
 

Diff for: analysis/reanalyze/src/DeadCommon.ml

@@ -375,7 +375,7 @@ let addDeclaration_ ?posEnd ?posStart ~declKind ~path ~(loc : Location.t)
         pos;
         posEnd;
         posStart;
-        resolved = false;
+        resolvedDead = None;
         report = true;
       }
     in
@@ -536,12 +536,22 @@ module Decl = struct
         | VariantCase ->
           (WarningDeadType, "is a variant case which is never constructed")
       in
+      let hasRefBelow () =
+        let refs = ValueReferences.find decl.pos in
+        let refIsBelow (pos : Lexing.position) =
+          decl.pos.pos_fname <> pos.pos_fname
+          || decl.pos.pos_cnum < pos.pos_cnum
+             && (* not a function defined inside a function, e.g. not a callback *)
+             decl.posEnd.pos_cnum < pos.pos_cnum
+        in
+        refs |> PosSet.exists refIsBelow
+      in
       let shouldEmitWarning =
         (not insideReportedValue)
-        &&
-        match decl.path with
-        | name :: _ when name |> Name.isUnderscore -> Config.reportUnderscore
-        | _ -> true
+        && (match decl.path with
+           | name :: _ when name |> Name.isUnderscore -> Config.reportUnderscore
+           | _ -> true)
+        && (runConfig.transitive || not (hasRefBelow ()))
       in
       if shouldEmitWarning then (
         decl.path
@@ -563,7 +573,7 @@ let doReportDead pos = not (ProcessDeadAnnotations.isAnnotatedGenTypeOrDead pos)
 let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level
     ~orderedFiles ~refs ~refsBeingResolved decl : bool =
   match decl.pos with
-  | _ when decl.resolved ->
+  | _ when decl.resolvedDead <> None ->
     if Config.recursiveDebug then
       Log_.item "recursiveDebug %s [%d] already resolved@."
         (decl.path |> Path.toString)
@@ -609,13 +619,13 @@ let rec resolveRecursiveRefs ~checkOptionalArg ~deadDeclarations ~level
                         ~level:(level + 1) ~orderedFiles ~refs:xRefs
                         ~refsBeingResolved
                  in
-                 if not xDecl.resolved then allDepsResolved := false;
+                 if xDecl.resolvedDead = None then allDepsResolved := false;
                  not xDeclIsDead)
     in
     let isDead = decl |> declIsDead ~refs:newRefs in
     let isResolved = (not isDead) || !allDepsResolved || level = 0 in
     if isResolved then (
-      decl.resolved <- true;
+      decl.resolvedDead <- Some isDead;
       if isDead then (
         decl.path
         |> DeadModules.markDead
@@ -691,4 +701,5 @@ let reportDead ~checkOptionalArg =
   let sortedDeadDeclarations =
     !deadDeclarations |> List.fast_sort Decl.compareForReporting
   in
+  (* XXX *)
   sortedDeadDeclarations |> List.iter Decl.report

Diff for: analysis/reanalyze/src/DeadModules.ml

@@ -1,4 +1,7 @@
-let active () = true
+let active () =
+  (* When transitive reporting is off, the only dead modules would be empty modules *)
+  RunConfig.runConfig.transitive
+
 let table = Hashtbl.create 1
 
 let markDead ~isType ~loc path =

Diff for: analysis/reanalyze/src/Paths.ml

@@ -73,6 +73,12 @@ module Config = struct
       (* if no "analysis" specified, default to dce *)
       RunConfig.dce ()
 
+  let readTransitive conf =
+    match Json.get "transitive" conf with
+    | Some True -> RunConfig.transitive true
+    | Some False -> RunConfig.transitive false
+    | _ -> ()
+
   (* Read the config from bsconfig.json and apply it to runConfig and suppress and unsuppress *)
   let processBsconfig () =
     Lazy.force setReScriptProjectRoot;
@@ -87,7 +93,8 @@ module Config = struct
         | Some conf ->
           readSuppress conf;
           readUnsuppress conf;
-          readAnalysis conf
+          readAnalysis conf;
+          readTransitive conf
         | None ->
           (* if no "analysis" specified, default to dce *)
           RunConfig.dce ()))

Diff for: analysis/reanalyze/src/RunConfig.ml

@@ -5,6 +5,7 @@ type t = {
   mutable projectRoot: string;
   mutable suppress: string list;
   mutable termination: bool;
+  mutable transitive: bool;
   mutable unsuppress: string list;
 }
 
@@ -16,6 +17,7 @@ let runConfig =
     projectRoot = "";
     suppress = [];
     termination = false;
+    transitive = true;
     unsuppress = [];
   }
 
@@ -27,3 +29,5 @@ let all () =
 let dce () = runConfig.dce <- true
 let exception_ () = runConfig.exception_ <- true
 let termination () = runConfig.termination <- true
+
+let transitive b = runConfig.transitive <- b