reanalyze: add parallel processing for CMT file analysis

Makefile

@@ -172,6 +172,16 @@ test: lib ninja
 test-analysis: lib ninja
 	make -C tests/analysis_tests clean test
 
+test-reanalyze: lib ninja
+	make -C tests/analysis_tests/tests-reanalyze/deadcode test
+
+test-reanalyze-parallel: lib ninja
+	make -C tests/analysis_tests/tests-reanalyze/deadcode test-parallel
+
+# Benchmark parallel analysis on larger codebase (COPIES=N for more files)
+benchmark-reanalyze: lib ninja
+	make -C tests/analysis_tests/tests-reanalyze/deadcode-benchmark benchmark COPIES=$(or $(COPIES),50)
+
 test-tools: lib ninja
 	make -C tests/tools_tests clean test
 
@@ -244,4 +254,4 @@ dev-container:
 
 .DEFAULT_GOAL := build
 
-.PHONY: yarn-install build ninja rewatch compiler lib artifacts bench test test-analysis test-tools test-syntax test-syntax-roundtrip test-gentype test-rewatch test-all playground playground-compiler playground-test playground-cmijs playground-release format checkformat clean-ninja clean-rewatch clean-compiler clean-lib clean-gentype clean-tests clean dev-container
+.PHONY: yarn-install build ninja rewatch compiler lib artifacts bench test test-analysis test-reanalyze test-reanalyze-parallel benchmark-reanalyze test-tools test-syntax test-syntax-roundtrip test-gentype test-rewatch test-all playground playground-compiler playground-test playground-cmijs playground-release format checkformat clean-ninja clean-rewatch clean-compiler clean-lib clean-gentype clean-tests clean dev-container

analysis/reanalyze/src/Cli.ml

@@ -21,3 +21,9 @@ let excludePaths = ref ([] : string list)
 
 (* test flag: shuffle file order to verify order-independence *)
 let testShuffle = ref false
+
+(* parallel processing: number of domains to use (0 = sequential) *)
+let parallel = ref 0
+
+(* timing: report internal timing of analysis phases *)
+let timing = ref false

analysis/reanalyze/src/DceFileProcessing.ml

@@ -32,6 +32,7 @@ let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes
   |> List.iter (fun sig_item ->
          DeadValue.processSignatureItem ~config ~decls ~file:dead_common_file
            ~doValues ~doTypes ~moduleLoc:Location.none
+           ~modulePath:ModulePath.initial
            ~path:[module_name_tagged file]
            sig_item)
 
@@ -81,7 +82,5 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath
       ~file:dead_common_file ~doTypes:true ~doExternals
       ~cmt_value_dependencies:cmt_infos.cmt_value_dependencies structure
   | _ -> ());
-  DeadType.TypeDependencies.forceDelayedItems ~config ~refs;
-  DeadType.TypeDependencies.clear ();
   (* Return builders - caller will merge and freeze *)
   {annotations; decls; refs; cross_file; file_deps}

analysis/reanalyze/src/DeadException.ml

@@ -1,16 +1,37 @@
 open DeadCommon
 
-let declarations = Hashtbl.create 1
+module PathMap = Map.Make (struct
+  type t = DcePath.t
 
-let add ~config ~decls ~file ~path ~loc ~(strLoc : Location.t) name =
-  let exceptionPath = name :: path in
-  Hashtbl.add declarations exceptionPath loc;
-  name
-  |> addDeclaration_ ~config ~decls ~file ~posEnd:strLoc.loc_end
-       ~posStart:strLoc.loc_start ~declKind:Exception
-       ~moduleLoc:(ModulePath.getCurrent ()).loc ~path ~loc
+  let compare = Stdlib.compare
+end)
+
+let find_exception_from_decls (decls : Declarations.t) :
+    DcePath.t -> Location.t option =
+  let index =
+    Declarations.fold
+      (fun _pos (decl : Decl.t) acc ->
+        match decl.Decl.declKind with
+        | Exception ->
+          (* Use raw decl positions: reference graph keys are raw positions. *)
+          let loc : Location.t =
+            {
+              Location.loc_start = decl.pos;
+              loc_end = decl.posEnd;
+              loc_ghost = false;
+            }
+          in
+          PathMap.add decl.path loc acc
+        | _ -> acc)
+      decls PathMap.empty
+  in
+  fun path -> PathMap.find_opt path index
 
-let find_exception path = Hashtbl.find_opt declarations path
+let add ~config ~decls ~file ~path ~loc ~(strLoc : Location.t)
+    ~(moduleLoc : Location.t) name =
+  addDeclaration_ ~config ~decls ~file ~posEnd:strLoc.loc_end
+    ~posStart:strLoc.loc_start ~declKind:Exception ~moduleLoc ~path ~loc name;
+  name
 
 let markAsUsed ~config ~refs ~file_deps ~cross_file ~(binding : Location.t)
     ~(locFrom : Location.t) ~(locTo : Location.t) path_ =

analysis/reanalyze/src/DeadException.mli

@@ -0,0 +1,25 @@
+open DeadCommon
+
+val find_exception_from_decls : Declarations.t -> DcePath.t -> Location.t option
+
+val add :
+  config:DceConfig.t ->
+  decls:Declarations.builder ->
+  file:FileContext.t ->
+  path:DcePath.t ->
+  loc:Location.t ->
+  strLoc:Location.t ->
+  moduleLoc:Location.t ->
+  Name.t ->
+  Name.t
+
+val markAsUsed :
+  config:DceConfig.t ->
+  refs:References.builder ->
+  file_deps:FileDeps.builder ->
+  cross_file:CrossFileItems.builder ->
+  binding:Location.t ->
+  locFrom:Location.t ->
+  locTo:Location.t ->
+  Path.t ->
+  unit

analysis/reanalyze/src/DeadType.ml

@@ -2,98 +2,32 @@
 
 open DeadCommon
 
-module TypeLabels = struct
-  (* map from type path (for record/variant label) to its location *)
-
-  let table = (Hashtbl.create 256 : (DcePath.t, Location.t) Hashtbl.t)
-  let add path loc = Hashtbl.replace table path loc
-  let find path = Hashtbl.find_opt table path
-end
-
 let addTypeReference ~config ~refs ~posFrom ~posTo =
   if config.DceConfig.cli.debug then
     Log_.item "addTypeReference %s --> %s@." (posFrom |> Pos.toString)
       (posTo |> Pos.toString);
   References.add_type_ref refs ~posTo ~posFrom
 
-module TypeDependencies = struct
-  let delayedItems = ref []
-  let add loc1 loc2 = delayedItems := (loc1, loc2) :: !delayedItems
-  let clear () = delayedItems := []
-
-  let processTypeDependency ~config ~refs
-      ( ({loc_start = posTo; loc_ghost = ghost1} : Location.t),
-        ({loc_start = posFrom; loc_ghost = ghost2} : Location.t) ) =
-    if (not ghost1) && (not ghost2) && posTo <> posFrom then
-      addTypeReference ~config ~refs ~posTo ~posFrom
-
-  let forceDelayedItems ~config ~refs =
-    List.iter (processTypeDependency ~config ~refs) !delayedItems
-end
-
-let extendTypeDependencies ~config (loc1 : Location.t) (loc2 : Location.t) =
-  if loc1.loc_start <> loc2.loc_start then (
-    if config.DceConfig.cli.debug then
-      Log_.item "extendTypeDependencies %s --> %s@."
-        (loc1.loc_start |> Pos.toString)
-        (loc2.loc_start |> Pos.toString);
-    TypeDependencies.add loc1 loc2)
-
-(* Type dependencies between Foo.re and Foo.rei *)
-let addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName
+let extendTypeDependencies ~config ~refs (loc1 : Location.t) (loc2 : Location.t)
     =
-  let isInterface = file.FileContext.is_interface in
-  if not isInterface then (
-    let path_1 = pathToType |> DcePath.moduleToInterface in
-    let path_2 = path_1 |> DcePath.typeToInterface in
-    let path1 = typeLabelName :: path_1 in
-    let path2 = typeLabelName :: path_2 in
-    match TypeLabels.find path1 with
-    | None -> (
-      match TypeLabels.find path2 with
-      | None -> ()
-      | Some loc2 ->
-        extendTypeDependencies ~config loc loc2;
-        if not Config.reportTypesDeadOnlyInInterface then
-          extendTypeDependencies ~config loc2 loc)
-    | Some loc1 ->
-      extendTypeDependencies ~config loc loc1;
-      if not Config.reportTypesDeadOnlyInInterface then
-        extendTypeDependencies ~config loc1 loc)
-  else
-    let path_1 = pathToType |> DcePath.moduleToImplementation in
-    let path1 = typeLabelName :: path_1 in
-    match TypeLabels.find path1 with
-    | None -> ()
-    | Some loc1 ->
-      extendTypeDependencies ~config loc1 loc;
-      if not Config.reportTypesDeadOnlyInInterface then
-        extendTypeDependencies ~config loc loc1
-
-(* Add type dependencies between implementation and interface in inner module *)
-let addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName =
-  let path = typeLabelName :: pathToType in
-  match TypeLabels.find path with
-  | Some loc2 ->
-    extendTypeDependencies ~config loc loc2;
-    if not Config.reportTypesDeadOnlyInInterface then
-      extendTypeDependencies ~config loc2 loc
-  | None -> TypeLabels.add path loc
+  let {Location.loc_start = posTo; loc_ghost = ghost1} = loc1 in
+  let {Location.loc_start = posFrom; loc_ghost = ghost2} = loc2 in
+  if (not ghost1) && (not ghost2) && posTo <> posFrom then (
+    if config.DceConfig.cli.debug then
+      Log_.item "extendTypeDependencies %s --> %s@." (posTo |> Pos.toString)
+        (posFrom |> Pos.toString);
+    addTypeReference ~config ~refs ~posFrom ~posTo)
 
-let addDeclaration ~config ~decls ~file ~(typeId : Ident.t)
-    ~(typeKind : Types.type_kind) =
-  let currentModulePath = ModulePath.getCurrent () in
+let addDeclaration ~config ~decls ~file ~(modulePath : ModulePath.t)
+    ~(typeId : Ident.t) ~(typeKind : Types.type_kind) =
   let pathToType =
     (typeId |> Ident.name |> Name.create)
-    :: (currentModulePath.path @ [FileContext.module_name_tagged file])
+    :: (modulePath.path @ [FileContext.module_name_tagged file])
   in
   let processTypeLabel ?(posAdjustment = Decl.Nothing) typeLabelName ~declKind
       ~(loc : Location.t) =
     addDeclaration_ ~config ~decls ~file ~declKind ~path:pathToType ~loc
-      ~moduleLoc:currentModulePath.loc ~posAdjustment typeLabelName;
-    addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName;
-    addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName;
-    TypeLabels.add (typeLabelName :: pathToType) loc
+      ~moduleLoc:modulePath.loc ~posAdjustment typeLabelName
   in
   match typeKind with
   | Type_record (l, _) ->
@@ -130,3 +64,102 @@ let addDeclaration ~config ~decls ~file ~(typeId : Ident.t)
         |> processTypeLabel ~declKind:VariantCase ~loc:cd_loc ~posAdjustment)
       decls
   | _ -> ()
+
+module PathMap = Map.Make (struct
+  type t = DcePath.t
+
+  let compare = Stdlib.compare
+end)
+
+let process_type_label_dependencies ~config ~decls ~refs =
+  (* Use raw declaration positions, not [declGetLoc], because references are keyed
+     by raw positions (decl.pos). [declGetLoc] applies [posAdjustment] (e.g. +2
+     for OtherVariant), which is intended for reporting locations, not for
+     reference graph keys. *)
+  let decl_raw_loc (decl : Decl.t) : Location.t =
+    {Location.loc_start = decl.pos; loc_end = decl.posEnd; loc_ghost = false}
+  in
+  (* Build an index from full label path -> list of locations *)
+  let index =
+    Declarations.fold
+      (fun _pos decl acc ->
+        match decl.Decl.declKind with
+        | RecordLabel | VariantCase ->
+          let loc = decl |> decl_raw_loc in
+          let path = decl.path in
+          let existing =
+            PathMap.find_opt path acc |> Option.value ~default:[]
+          in
+          PathMap.add path (loc :: existing) acc
+        | _ -> acc)
+      decls PathMap.empty
+  in
+  (* Inner-module duplicates: if the same full path appears multiple times (e.g. from signature+structure),
+     connect them together. *)
+  index
+  |> PathMap.iter (fun _key locs ->
+         match locs with
+         | [] | [_] -> ()
+         | loc0 :: rest ->
+           rest
+           |> List.iter (fun loc ->
+                  extendTypeDependencies ~config ~refs loc loc0;
+                  if not Config.reportTypesDeadOnlyInInterface then
+                    extendTypeDependencies ~config ~refs loc0 loc));
+
+  (* Cross-file impl<->intf linking, modeled after the previous lookup logic. *)
+  let hd_opt = function
+    | [] -> None
+    | x :: _ -> Some x
+  in
+  let find_one path =
+    match PathMap.find_opt path index with
+    | None -> None
+    | Some locs -> hd_opt locs
+  in
+
+  let is_interface_of_pathToType (pathToType : DcePath.t) =
+    match List.rev pathToType with
+    | moduleNameTag :: _ -> (
+      try (moduleNameTag |> Name.toString).[0] <> '+'
+      with Invalid_argument _ -> true)
+    | [] -> true
+  in
+
+  Declarations.iter
+    (fun _pos decl ->
+      match decl.Decl.declKind with
+      | RecordLabel | VariantCase -> (
+        match decl.path with
+        | [] -> ()
+        | typeLabelName :: pathToType -> (
+          let loc = decl |> decl_raw_loc in
+          let isInterface = is_interface_of_pathToType pathToType in
+          if not isInterface then
+            let path_1 = pathToType |> DcePath.moduleToInterface in
+            let path_2 = path_1 |> DcePath.typeToInterface in
+            let path1 = typeLabelName :: path_1 in
+            let path2 = typeLabelName :: path_2 in
+            match find_one path1 with
+            | Some loc1 ->
+              extendTypeDependencies ~config ~refs loc loc1;
+              if not Config.reportTypesDeadOnlyInInterface then
+                extendTypeDependencies ~config ~refs loc1 loc
+            | None -> (
+              match find_one path2 with
+              | Some loc2 ->
+                extendTypeDependencies ~config ~refs loc loc2;
+                if not Config.reportTypesDeadOnlyInInterface then
+                  extendTypeDependencies ~config ~refs loc2 loc
+              | None -> ())
+          else
+            let path_1 = pathToType |> DcePath.moduleToImplementation in
+            let path1 = typeLabelName :: path_1 in
+            match find_one path1 with
+            | None -> ()
+            | Some loc1 ->
+              extendTypeDependencies ~config ~refs loc1 loc;
+              if not Config.reportTypesDeadOnlyInInterface then
+                extendTypeDependencies ~config ~refs loc loc1))
+      | _ -> ())
+    decls