From 683aeec06807c60d95fccb94b6cbf5347dea6a1d Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 03:42:32 +0100 Subject: [PATCH 01/12] reanalyze: make ModulePath pure during AST traversal Remove global ModulePath mutable state used during per-file AST traversal by threading ModulePath.t explicitly through traversal code. This is preparation for parallel per-file processing and reduces shared global state during MAP. Signed-Off-By: Cristiano Calcagno --- analysis/reanalyze/src/DceFileProcessing.ml | 1 + analysis/reanalyze/src/DeadException.ml | 6 +- analysis/reanalyze/src/DeadType.ml | 9 +- analysis/reanalyze/src/DeadValue.ml | 218 ++++++++++---------- analysis/reanalyze/src/Exception.ml | 115 +++++++---- analysis/reanalyze/src/ModulePath.ml | 15 +- 6 files changed, 203 insertions(+), 161 deletions(-) diff --git a/analysis/reanalyze/src/DceFileProcessing.ml b/analysis/reanalyze/src/DceFileProcessing.ml index a012b163ec..b0eb42786d 100644 --- a/analysis/reanalyze/src/DceFileProcessing.ml +++ b/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) diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index caaa108cb4..3ad2b76d35 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/analysis/reanalyze/src/DeadException.ml @@ -2,13 +2,13 @@ open DeadCommon let declarations = Hashtbl.create 1 -let add ~config ~decls ~file ~path ~loc ~(strLoc : Location.t) name = +let add ~config ~decls ~file ~path ~loc ~(strLoc : Location.t) + ~(moduleLoc : 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 + ~posStart:strLoc.loc_start ~declKind:Exception ~moduleLoc ~path ~loc let find_exception path = Hashtbl.find_opt declarations path diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index 402c4b0340..3183ce4f0d 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -80,17 +80,16 @@ let addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName = extendTypeDependencies ~config loc2 loc | None -> TypeLabels.add path loc -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; + ~moduleLoc:modulePath.loc ~posAdjustment typeLabelName; addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName; addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName; TypeLabels.add (typeLabelName :: pathToType) loc diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index c75a6d0ac8..a6c266e264 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -3,22 +3,22 @@ open DeadCommon let checkAnyValueBindingWithNoSideEffects ~config ~decls ~file + ~(modulePath : ModulePath.t) ({vb_pat = {pat_desc}; vb_expr = expr; vb_loc = loc} : Typedtree.value_binding) = match pat_desc with | Tpat_any when (not (SideEffects.checkExpr expr)) && not loc.loc_ghost -> let name = "_" |> Name.create ~isInterface:false in - let currentModulePath = ModulePath.getCurrent () in - let path = currentModulePath.path @ [FileContext.module_name_tagged file] in + let path = modulePath.path @ [FileContext.module_name_tagged file] in name |> addValueDeclaration ~config ~decls ~file ~path ~loc - ~moduleLoc:currentModulePath.loc ~sideEffects:false + ~moduleLoc:modulePath.loc ~sideEffects:false | _ -> () let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t) - (vb : Typedtree.value_binding) = + ~(modulePath : ModulePath.t) (vb : Typedtree.value_binding) = let oldLastBinding = current_binding in - checkAnyValueBindingWithNoSideEffects ~config ~decls ~file vb; + checkAnyValueBindingWithNoSideEffects ~config ~decls ~file ~modulePath vb; let loc = match vb.vb_pat.pat_desc with | Tpat_var (id, {loc = {loc_start; loc_ghost} as loc}) @@ -37,10 +37,7 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t) true | _ -> false in - let currentModulePath = ModulePath.getCurrent () in - let path = - currentModulePath.path @ [FileContext.module_name_tagged file] - in + let path = modulePath.path @ [FileContext.module_name_tagged file] in let isFirstClassModule = match vb.vb_expr.exp_type.desc with | Tpackage _ -> true @@ -52,7 +49,7 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t) let sideEffects = SideEffects.checkExpr vb.vb_expr in name |> addValueDeclaration ~config ~decls ~file ~isToplevel ~loc - ~moduleLoc:currentModulePath.loc ~optionalArgs ~path ~sideEffects); + ~moduleLoc:modulePath.loc ~optionalArgs ~path ~sideEffects); (match Declarations.find_opt_builder decls loc_start with | None -> () | Some decl -> @@ -246,12 +243,11 @@ let rec getSignature (moduleType : Types.module_type) = | _ -> [] let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc - ~path (si : Types.signature_item) = - let oldModulePath = ModulePath.getCurrent () in - (match si with + ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) = + match si with | Sig_type (id, t, _) when doTypes -> if !Config.analyzeTypes then - DeadType.addDeclaration ~config ~decls ~file ~typeId:id + DeadType.addDeclaration ~config ~decls ~file ~modulePath ~typeId:id ~typeKind:t.type_kind | Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type}) when doValues -> @@ -274,12 +270,11 @@ let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc ~optionalArgs ~path ~sideEffects:false | Sig_module (id, {Types.md_type = moduleType; md_loc = moduleLoc}, _) | Sig_modtype (id, {Types.mtd_type = Some moduleType; mtd_loc = moduleLoc}) -> - ModulePath.setCurrent - { - oldModulePath with - loc = moduleLoc; - path = (id |> Ident.name |> Name.create) :: oldModulePath.path; - }; + let modulePath' = + ModulePath.enterModule modulePath + ~name:(id |> Ident.name |> Name.create) + ~loc:moduleLoc + in let collect = match si with | Sig_modtype _ -> false @@ -289,15 +284,15 @@ let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc getSignature moduleType |> List.iter (processSignatureItem ~config ~decls ~file ~doTypes ~doValues - ~moduleLoc + ~moduleLoc ~modulePath:modulePath' ~path:((id |> Ident.name |> Name.create) :: path)) - | _ -> ()); - ModulePath.setCurrent oldModulePath + | _ -> () (* Traverse the AST *) let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes ~doExternals (structure : Typedtree.structure) : unit = - let rec create_mapper (last_binding : Location.t) = + let rec create_mapper (last_binding : Location.t) (modulePath : ModulePath.t) + = let super = Tast_mapper.default in let rec mapper = { @@ -310,103 +305,112 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes pat = (fun _self p -> p |> collectPattern ~config ~refs super mapper); structure_item = (fun _self (structureItem : Typedtree.structure_item) -> - let oldModulePath = ModulePath.getCurrent () in - (match structureItem.str_desc with - | Tstr_module {mb_expr; mb_id; mb_loc} -> ( - let hasInterface = - match mb_expr.mod_desc with - | Tmod_constraint _ -> true - | _ -> false - in - ModulePath.setCurrent - { - oldModulePath with - loc = mb_loc; - path = - (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; - }; - if hasInterface then - match mb_expr.mod_type with - | Mty_signature signature -> - signature + let modulePath_for_item_opt = + match structureItem.str_desc with + | Tstr_module {mb_expr; mb_id; mb_loc} -> + let hasInterface = + match mb_expr.mod_desc with + | Tmod_constraint _ -> true + | _ -> false + in + let modulePath' = + ModulePath.enterModule modulePath + ~name:(mb_id |> Ident.name |> Name.create) + ~loc:mb_loc + in + if hasInterface then + match mb_expr.mod_type with + | Mty_signature signature -> + signature + |> List.iter + (processSignatureItem ~config ~decls ~file ~doTypes + ~doValues:false ~moduleLoc:mb_expr.mod_loc + ~modulePath:modulePath' + ~path: + (modulePath'.path + @ [FileContext.module_name_tagged file])) + | _ -> () + else (); + Some modulePath' + | Tstr_primitive vd when doExternals && !Config.analyzeExternals + -> + let path = + modulePath.path @ [FileContext.module_name_tagged file] + in + let exists = + match + Declarations.find_opt_builder decls vd.val_loc.loc_start + with + | Some {declKind = Value _} -> true + | _ -> false + in + let id = vd.val_id |> Ident.name in + Printf.printf "Primitive %s\n" id; + if + (not exists) && id <> "unsafe_expr" + (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) + then + id + |> Name.create ~isInterface:false + |> addValueDeclaration ~config ~decls ~file ~path + ~loc:vd.val_loc ~moduleLoc:modulePath.loc + ~sideEffects:false; + None + | Tstr_type (_recFlag, typeDeclarations) when doTypes -> + if !Config.analyzeTypes then + typeDeclarations + |> List.iter + (fun (typeDeclaration : Typedtree.type_declaration) -> + DeadType.addDeclaration ~config ~decls ~file + ~modulePath ~typeId:typeDeclaration.typ_id + ~typeKind:typeDeclaration.typ_type.type_kind); + None + | Tstr_include {incl_mod; incl_type} -> + (match incl_mod.mod_desc with + | Tmod_ident (_path, _lid) -> + let currentPath = + modulePath.path @ [FileContext.module_name_tagged file] + in + incl_type |> List.iter (processSignatureItem ~config ~decls ~file ~doTypes - ~doValues:false ~moduleLoc:mb_expr.mod_loc - ~path: - ((ModulePath.getCurrent ()).path - @ [FileContext.module_name_tagged file])) - | _ -> ()) - | Tstr_primitive vd when doExternals && !Config.analyzeExternals -> - let currentModulePath = ModulePath.getCurrent () in - let path = - currentModulePath.path @ [FileContext.module_name_tagged file] - in - let exists = - match - Declarations.find_opt_builder decls vd.val_loc.loc_start - with - | Some {declKind = Value _} -> true - | _ -> false - in - let id = vd.val_id |> Ident.name in - Printf.printf "Primitive %s\n" id; - if - (not exists) && id <> "unsafe_expr" - (* see https://github.com/BuckleScript/bucklescript/issues/4532 *) - then - id - |> Name.create ~isInterface:false - |> addValueDeclaration ~config ~decls ~file ~path - ~loc:vd.val_loc ~moduleLoc:currentModulePath.loc - ~sideEffects:false - | Tstr_type (_recFlag, typeDeclarations) when doTypes -> - if !Config.analyzeTypes then - typeDeclarations - |> List.iter - (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~config ~decls ~file - ~typeId:typeDeclaration.typ_id - ~typeKind:typeDeclaration.typ_type.type_kind) - | Tstr_include {incl_mod; incl_type} -> ( - match incl_mod.mod_desc with - | Tmod_ident (_path, _lid) -> - let currentPath = - (ModulePath.getCurrent ()).path - @ [FileContext.module_name_tagged file] + ~doValues:false (* TODO: also values? *) + ~moduleLoc:incl_mod.mod_loc ~modulePath + ~path:currentPath) + | _ -> ()); + None + | Tstr_exception {ext_id = id; ext_loc = loc} -> + let path = + modulePath.path @ [FileContext.module_name_tagged file] in - incl_type - |> List.iter - (processSignatureItem ~config ~decls ~file ~doTypes - ~doValues:false (* TODO: also values? *) - ~moduleLoc:incl_mod.mod_loc ~path:currentPath) - | _ -> ()) - | Tstr_exception {ext_id = id; ext_loc = loc} -> - let path = - (ModulePath.getCurrent ()).path - @ [FileContext.module_name_tagged file] - in - let name = id |> Ident.name |> Name.create in - name - |> DeadException.add ~config ~decls ~file ~path ~loc - ~strLoc:structureItem.str_loc - | _ -> ()); - let result = super.structure_item mapper structureItem in - ModulePath.setCurrent oldModulePath; - result); + let name = id |> Ident.name |> Name.create in + name + |> DeadException.add ~config ~decls ~file ~path ~loc + ~strLoc:structureItem.str_loc ~moduleLoc:modulePath.loc; + None + | _ -> None + in + let mapper_for_item = + match modulePath_for_item_opt with + | None -> mapper + | Some modulePath_for_item -> + create_mapper last_binding modulePath_for_item + in + super.structure_item mapper_for_item structureItem); value_binding = (fun _self vb -> let loc = vb |> collectValueBinding ~config ~decls ~file - ~current_binding:last_binding + ~current_binding:last_binding ~modulePath in - let nested_mapper = create_mapper loc in + let nested_mapper = create_mapper loc modulePath in super.Tast_mapper.value_binding nested_mapper vb); } in mapper in - let mapper = create_mapper Location.none in + let mapper = create_mapper Location.none ModulePath.initial in mapper.structure mapper structure |> ignore (* Merge a location's references to another one's *) diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index 9cf5d4ff39..146974d650 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -6,8 +6,8 @@ module Values = struct let currentFileTable = ref (Hashtbl.create 1) - let add ~name exceptions = - let path = (name |> Name.create) :: (ModulePath.getCurrent ()).path in + let add ~modulePath ~name exceptions = + let path = (name |> Name.create) :: modulePath.ModulePath.path in Hashtbl.replace !currentFileTable (path |> DcePath.toName) exceptions let getFromModule ~moduleName ~modulePath (path_ : DcePath.t) = @@ -219,7 +219,6 @@ module Checks = struct end let traverseAst ~file () = - ModulePath.init (); let super = Tast_mapper.default in let currentId = ref "" in let currentEvents = ref [] in @@ -267,14 +266,17 @@ let traverseAst ~file () = | _ -> false) <> None in - let expr (self : Tast_mapper.mapper) (expr : Typedtree.expression) = + let expr ~(modulePath : ModulePath.t) (self : Tast_mapper.mapper) + (expr : Typedtree.expression) = let loc = expr.exp_loc in let isDoesNoThrow = expr.exp_attributes |> doesNotThrow in let oldEvents = !currentEvents in if isDoesNoThrow then currentEvents := []; (match expr.exp_desc with | Texp_ident (callee_, _, _) -> - let callee = callee_ |> DcePath.fromPathT |> ModulePath.resolveAlias in + let callee = + callee_ |> DcePath.fromPathT |> ModulePath.resolveAlias modulePath + in let calleeName = callee |> DcePath.toName in if calleeName |> Name.toString |> isThrow then Log_.warning ~loc @@ -289,7 +291,7 @@ let traverseAst ~file () = { Event.exceptions = Exceptions.empty; loc; - kind = Call {callee; modulePath = (ModulePath.getCurrent ()).path}; + kind = Call {callee; modulePath = modulePath.path}; } :: !currentEvents | Texp_apply @@ -398,30 +400,8 @@ let traverseAst ~file () = currentId := oldId; currentEvents := oldEvents in - let structure_item (self : Tast_mapper.mapper) - (structureItem : Typedtree.structure_item) = - let oldModulePath = ModulePath.getCurrent () in - (match structureItem.str_desc with - | Tstr_eval (expr, attributes) -> toplevelEval self expr attributes - | Tstr_module {mb_id; mb_loc} -> - ModulePath.setCurrent - { - oldModulePath with - loc = mb_loc; - path = (mb_id |> Ident.name |> Name.create) :: oldModulePath.path; - } - | _ -> ()); - let result = super.structure_item self structureItem in - ModulePath.setCurrent oldModulePath; - (match structureItem.str_desc with - | Tstr_module {mb_id; mb_expr = {mod_desc = Tmod_ident (path_, _lid)}} -> - ModulePath.addAlias - ~name:(mb_id |> Ident.name |> Name.create) - ~path:(path_ |> DcePath.fromPathT) - | _ -> ()); - result - in - let value_binding (self : Tast_mapper.mapper) (vb : Typedtree.value_binding) = + let value_binding ~(modulePath : ModulePath.t) (self : Tast_mapper.mapper) + (vb : Typedtree.value_binding) = let oldId = !currentId in let oldEvents = !currentEvents in let isFunction = @@ -436,15 +416,13 @@ let traverseAst ~file () = let exceptionsFromAnnotations = getExceptionsFromAnnotations vb.vb_attributes in - exceptionsFromAnnotations |> Values.add ~name; + exceptionsFromAnnotations |> Values.add ~modulePath ~name; let res = super.value_binding self vb in let moduleName = file.FileContext.module_name in let path = [name |> Name.create] in let exceptions = match - path - |> Values.findPath ~moduleName - ~modulePath:(ModulePath.getCurrent ()).path + path |> Values.findPath ~moduleName ~modulePath:modulePath.path with | Some exceptions -> exceptions | _ -> Exceptions.empty @@ -467,12 +445,73 @@ let traverseAst ~file () = processBinding (id |> Ident.name) | _ -> super.value_binding self vb in - let open Tast_mapper in - {super with expr; value_binding; structure_item} + let make_mapper (modulePath : ModulePath.t) : Tast_mapper.mapper = + let open Tast_mapper in + { + super with + expr = expr ~modulePath; + value_binding = value_binding ~modulePath; + } + in + let rec process_module_expr (modulePath : ModulePath.t) + (me : Typedtree.module_expr) = + match me.mod_desc with + | Tmod_structure structure -> process_structure modulePath structure + | Tmod_constraint (me1, _mty, _mtc, _coercion) -> + process_module_expr modulePath me1 + | Tmod_apply (me1, me2, _) -> + process_module_expr modulePath me1; + process_module_expr modulePath me2 + | _ -> + let mapper = make_mapper modulePath in + super.module_expr mapper me |> ignore + and process_structure (modulePath : ModulePath.t) + (structure : Typedtree.structure) = + let rec loop (mp : ModulePath.t) (items : Typedtree.structure_item list) = + match items with + | [] -> () + | structureItem :: rest -> + let mapper = make_mapper mp in + let mp' = + match structureItem.str_desc with + | Tstr_eval (expr, attributes) -> + toplevelEval mapper expr attributes; + mp + | Tstr_module {mb_id; mb_loc; mb_expr} -> ( + let name = mb_id |> Ident.name |> Name.create in + let mp_inside = ModulePath.enterModule mp ~name ~loc:mb_loc in + process_module_expr mp_inside mb_expr; + match mb_expr.mod_desc with + | Tmod_ident (path_, _lid) -> + ModulePath.addAlias mp ~name ~path:(path_ |> DcePath.fromPathT) + | _ -> mp) + | Tstr_recmodule mbs -> + (* Process each module in the recursive group in the current scope; aliases are collected in the current scope too. *) + List.fold_left + (fun acc {Typedtree.mb_id; mb_loc; mb_expr} -> + let name = mb_id |> Ident.name |> Name.create in + let mp_inside = ModulePath.enterModule acc ~name ~loc:mb_loc in + process_module_expr mp_inside mb_expr; + match mb_expr.mod_desc with + | Tmod_ident (path_, _lid) -> + ModulePath.addAlias acc ~name + ~path:(path_ |> DcePath.fromPathT) + | _ -> acc) + mp mbs + | _ -> + super.structure_item mapper structureItem |> ignore; + mp + in + loop mp' rest + in + loop modulePath structure.str_items + in + fun (structure : Typedtree.structure) -> + process_structure ModulePath.initial structure let processStructure ~file (structure : Typedtree.structure) = - let traverseAst = traverseAst ~file () in - structure |> traverseAst.structure traverseAst |> ignore + let process = traverseAst ~file () in + process structure let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) = match cmt_infos.cmt_annots with diff --git a/analysis/reanalyze/src/ModulePath.ml b/analysis/reanalyze/src/ModulePath.ml index 3d9e6b9aad..f32087d7fa 100644 --- a/analysis/reanalyze/src/ModulePath.ml +++ b/analysis/reanalyze/src/ModulePath.ml @@ -4,8 +4,6 @@ module NameMap = Map.Make (Name) type t = {aliases: DcePath.t NameMap.t; loc: Location.t; path: DcePath.t} let initial = ({aliases = NameMap.empty; loc = Location.none; path = []} : t) -let current = (ref initial : t ref) -let init () = current := initial let normalizePath ~aliases path = match path |> List.rev with @@ -20,14 +18,15 @@ let normalizePath ~aliases path = newPath) | _ -> path -let addAlias ~name ~path = - let aliases = !current.aliases in +let addAlias (t : t) ~name ~path : t = + let aliases = t.aliases in let pathNormalized = path |> normalizePath ~aliases in if !Cli.debug then Log_.item "Module Alias: %s = %s@." (name |> Name.toString) (DcePath.toString pathNormalized); - current := {!current with aliases = NameMap.add name pathNormalized aliases} + {t with aliases = NameMap.add name pathNormalized aliases} -let resolveAlias path = path |> normalizePath ~aliases:!current.aliases -let getCurrent () = !current -let setCurrent p = current := p +let resolveAlias (t : t) path = path |> normalizePath ~aliases:t.aliases + +let enterModule (t : t) ~(name : Name.t) ~(loc : Location.t) : t = + {t with loc; path = name :: t.path} From 0586a955a32bf8086821a936efb771306cf2b591 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 04:39:58 +0100 Subject: [PATCH 02/12] reanalyze: remove global TypeDependencies buffer Record type dependency edges immediately instead of buffering them in a global ref and flushing at end-of-file. Note: this reorders debug output in reanalyze logs: addTypeReference lines now appear next to extendTypeDependencies, rather than being emitted in a later end-of-file flush. Signed-Off-By: Cristiano Calcagno --- analysis/reanalyze/src/DceFileProcessing.ml | 12 ++-- analysis/reanalyze/src/DeadType.ml | 59 ++++++++----------- analysis/reanalyze/src/DeadValue.ml | 14 ++--- .../deadcode/expected/deadcode.txt | 46 +++++++-------- 4 files changed, 59 insertions(+), 72 deletions(-) diff --git a/analysis/reanalyze/src/DceFileProcessing.ml b/analysis/reanalyze/src/DceFileProcessing.ml index b0eb42786d..c6e42a9c89 100644 --- a/analysis/reanalyze/src/DceFileProcessing.ml +++ b/analysis/reanalyze/src/DceFileProcessing.ml @@ -19,8 +19,8 @@ let module_name_tagged (file : file_context) = (* ===== Signature processing ===== *) -let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes - (signature : Types.signature) = +let processSignature ~config ~decls ~refs ~(file : file_context) ~doValues + ~doTypes (signature : Types.signature) = let dead_common_file : FileContext.t = { source_path = file.source_path; @@ -31,7 +31,7 @@ let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes signature |> List.iter (fun sig_item -> DeadValue.processSignatureItem ~config ~decls ~file:dead_common_file - ~doValues ~doTypes ~moduleLoc:Location.none + ~refs ~doValues ~doTypes ~moduleLoc:Location.none ~modulePath:ModulePath.initial ~path:[module_name_tagged file] sig_item) @@ -67,7 +67,7 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath (match cmt_infos.cmt_annots with | Interface signature -> CollectAnnotations.signature ~state:annotations ~config signature; - processSignature ~config ~decls ~file ~doValues:true ~doTypes:true + processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:true signature.sig_type | Implementation structure -> let cmtiExists = @@ -75,14 +75,12 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath in CollectAnnotations.structure ~state:annotations ~config ~doGenType:(not cmtiExists) structure; - processSignature ~config ~decls ~file ~doValues:true ~doTypes:false + processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:false structure.str_type; let doExternals = false in DeadValue.processStructure ~config ~decls ~refs ~file_deps ~cross_file ~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} diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index 3183ce4f0d..cc3bc7401a 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -16,32 +16,19 @@ let addTypeReference ~config ~refs ~posFrom ~posTo = (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 ( +let extendTypeDependencies ~config ~refs (loc1 : Location.t) (loc2 : Location.t) + = + 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@." - (loc1.loc_start |> Pos.toString) - (loc2.loc_start |> Pos.toString); - TypeDependencies.add loc1 loc2) + Log_.item "extendTypeDependencies %s --> %s@." (posTo |> Pos.toString) + (posFrom |> Pos.toString); + addTypeReference ~config ~refs ~posFrom ~posTo) (* Type dependencies between Foo.re and Foo.rei *) -let addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName - = +let addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc + ~typeLabelName = let isInterface = file.FileContext.is_interface in if not isInterface then ( let path_1 = pathToType |> DcePath.moduleToInterface in @@ -53,34 +40,35 @@ let addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName match TypeLabels.find path2 with | None -> () | Some loc2 -> - extendTypeDependencies ~config loc loc2; + extendTypeDependencies ~config ~refs loc loc2; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config loc2 loc) + extendTypeDependencies ~config ~refs loc2 loc) | Some loc1 -> - extendTypeDependencies ~config loc loc1; + extendTypeDependencies ~config ~refs loc loc1; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config loc1 loc) + extendTypeDependencies ~config ~refs 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; + extendTypeDependencies ~config ~refs loc1 loc; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config loc loc1 + extendTypeDependencies ~config ~refs loc loc1 (* Add type dependencies between implementation and interface in inner module *) -let addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName = +let addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName + = let path = typeLabelName :: pathToType in match TypeLabels.find path with | Some loc2 -> - extendTypeDependencies ~config loc loc2; + extendTypeDependencies ~config ~refs loc loc2; if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config loc2 loc + extendTypeDependencies ~config ~refs loc2 loc | None -> TypeLabels.add path loc -let addDeclaration ~config ~decls ~file ~(modulePath : ModulePath.t) +let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t) ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = let pathToType = (typeId |> Ident.name |> Name.create) @@ -90,8 +78,9 @@ let addDeclaration ~config ~decls ~file ~(modulePath : ModulePath.t) ~(loc : Location.t) = addDeclaration_ ~config ~decls ~file ~declKind ~path:pathToType ~loc ~moduleLoc:modulePath.loc ~posAdjustment typeLabelName; - addTypeDependenciesAcrossFiles ~config ~file ~pathToType ~loc ~typeLabelName; - addTypeDependenciesInnerModule ~config ~pathToType ~loc ~typeLabelName; + addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc + ~typeLabelName; + addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName; TypeLabels.add (typeLabelName :: pathToType) loc in match typeKind with diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index a6c266e264..3f57c51e40 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -242,12 +242,12 @@ let rec getSignature (moduleType : Types.module_type) = | Mty_functor (_, _mtParam, mt) -> getSignature mt | _ -> [] -let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc - ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) = +let rec processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues + ~moduleLoc ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) = match si with | Sig_type (id, t, _) when doTypes -> if !Config.analyzeTypes then - DeadType.addDeclaration ~config ~decls ~file ~modulePath ~typeId:id + DeadType.addDeclaration ~config ~decls ~refs ~file ~modulePath ~typeId:id ~typeKind:t.type_kind | Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type}) when doValues -> @@ -283,7 +283,7 @@ let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc if collect then getSignature moduleType |> List.iter - (processSignatureItem ~config ~decls ~file ~doTypes ~doValues + (processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues ~moduleLoc ~modulePath:modulePath' ~path:((id |> Ident.name |> Name.create) :: path)) | _ -> () @@ -323,7 +323,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes | Mty_signature signature -> signature |> List.iter - (processSignatureItem ~config ~decls ~file ~doTypes + (processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues:false ~moduleLoc:mb_expr.mod_loc ~modulePath:modulePath' ~path: @@ -361,7 +361,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes typeDeclarations |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~config ~decls ~file + DeadType.addDeclaration ~config ~decls ~refs ~file ~modulePath ~typeId:typeDeclaration.typ_id ~typeKind:typeDeclaration.typ_type.type_kind); None @@ -373,7 +373,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes in incl_type |> List.iter - (processSignatureItem ~config ~decls ~file ~doTypes + (processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues:false (* TODO: also values? *) ~moduleLoc:incl_mod.mod_loc ~modulePath ~path:currentPath) diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 83ad64595e..376237d948 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -67,14 +67,14 @@ Scanning DeadRT.cmti Source:DeadRT.resi addVariantCaseDeclaration Root DeadRT.resi:2:2 path:DeadRT.moduleAccessPath extendTypeDependencies DeadRT.res:2:2 --> DeadRT.resi:2:2 + addTypeReference DeadRT.resi:2:2 --> DeadRT.res:2:2 extendTypeDependencies DeadRT.resi:2:2 --> DeadRT.res:2:2 + addTypeReference DeadRT.res:2:2 --> DeadRT.resi:2:2 addVariantCaseDeclaration Kaboom DeadRT.resi:3:2 path:DeadRT.moduleAccessPath extendTypeDependencies DeadRT.res:3:2 --> DeadRT.resi:3:2 + addTypeReference DeadRT.resi:3:2 --> DeadRT.res:3:2 extendTypeDependencies DeadRT.resi:3:2 --> DeadRT.res:3:2 addTypeReference DeadRT.res:3:2 --> DeadRT.resi:3:2 - addTypeReference DeadRT.resi:3:2 --> DeadRT.res:3:2 - addTypeReference DeadRT.res:2:2 --> DeadRT.resi:2:2 - addTypeReference DeadRT.resi:2:2 --> DeadRT.res:2:2 Scanning DeadTest.cmt Source:DeadTest.res addValueDeclaration +fortytwo DeadTest.res:2:4 path:+DeadTest addValueDeclaration +fortyTwoButExported DeadTest.res:5:4 path:+DeadTest @@ -117,7 +117,9 @@ addVariantCaseDeclaration A DeadTest.res:35:11 path:+DeadTest.VariantUsedOnlyInImplementation.t addVariantCaseDeclaration A DeadTest.res:38:11 path:+DeadTest.VariantUsedOnlyInImplementation.t extendTypeDependencies DeadTest.res:38:11 --> DeadTest.res:35:11 + addTypeReference DeadTest.res:35:11 --> DeadTest.res:38:11 extendTypeDependencies DeadTest.res:35:11 --> DeadTest.res:38:11 + addTypeReference DeadTest.res:38:11 --> DeadTest.res:35:11 addValueDeclaration +a DeadTest.res:39:6 path:+DeadTest.VariantUsedOnlyInImplementation addTypeReference DeadTest.res:39:10 --> DeadTest.res:38:11 addValueReference DeadTest.res:42:17 --> DeadTest.res:36:2 @@ -170,7 +172,9 @@ addVariantCaseDeclaration A DeadTest.res:137:13 path:+DeadTest.WithInclude.T.t addVariantCaseDeclaration A DeadTest.res:137:13 path:+DeadTest.WithInclude.t extendTypeDependencies DeadTest.res:137:13 --> DeadTest.res:134:11 + addTypeReference DeadTest.res:134:11 --> DeadTest.res:137:13 extendTypeDependencies DeadTest.res:134:11 --> DeadTest.res:137:13 + addTypeReference DeadTest.res:137:13 --> DeadTest.res:134:11 addTypeReference DeadTest.res:142:7 --> DeadTest.res:134:11 addValueDeclaration +x DeadTest.res:146:6 path:+DeadTest addValueDeclaration +y DeadTest.res:147:6 path:+DeadTest @@ -203,10 +207,6 @@ addValueReference DeadTest.res:36:2 --> DeadTest.res:39:6 addValueReference DeadTest.res:60:2 --> DeadTest.res:64:6 addValueReference DeadTest.res:61:2 --> DeadTest.res:63:6 - addTypeReference DeadTest.res:137:13 --> DeadTest.res:134:11 - addTypeReference DeadTest.res:134:11 --> DeadTest.res:137:13 - addTypeReference DeadTest.res:38:11 --> DeadTest.res:35:11 - addTypeReference DeadTest.res:35:11 --> DeadTest.res:38:11 Scanning DeadTestBlacklist.cmt Source:DeadTestBlacklist.res addValueDeclaration +x DeadTestBlacklist.res:1:4 path:+DeadTestBlacklist Scanning DeadTestWithInterface.cmt Source:DeadTestWithInterface.res @@ -234,35 +234,35 @@ Scanning DeadTypeTest.cmti Source:DeadTypeTest.resi addVariantCaseDeclaration A DeadTypeTest.resi:2:2 path:DeadTypeTest.t extendTypeDependencies DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 + addTypeReference DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 extendTypeDependencies DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 + addTypeReference DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 addVariantCaseDeclaration B DeadTypeTest.resi:3:2 path:DeadTypeTest.t extendTypeDependencies DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 + addTypeReference DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 extendTypeDependencies DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 + addTypeReference DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 addValueDeclaration +a DeadTypeTest.resi:4:0 path:DeadTypeTest addVariantCaseDeclaration OnlyInImplementation DeadTypeTest.resi:7:2 path:DeadTypeTest.deadType extendTypeDependencies DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 + addTypeReference DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 extendTypeDependencies DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 + addTypeReference DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 addVariantCaseDeclaration OnlyInInterface DeadTypeTest.resi:8:2 path:DeadTypeTest.deadType extendTypeDependencies DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 + addTypeReference DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 extendTypeDependencies DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 + addTypeReference DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 addVariantCaseDeclaration InBoth DeadTypeTest.resi:9:2 path:DeadTypeTest.deadType extendTypeDependencies DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 + addTypeReference DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 extendTypeDependencies DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 + addTypeReference DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 addVariantCaseDeclaration InNeither DeadTypeTest.resi:10:2 path:DeadTypeTest.deadType extendTypeDependencies DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 + addTypeReference DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 extendTypeDependencies DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 addTypeReference DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 - addTypeReference DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 - addTypeReference DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 - addTypeReference DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 - addTypeReference DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 - addTypeReference DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 - addTypeReference DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 - addTypeReference DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 - addTypeReference DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 - addTypeReference DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 - addTypeReference DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 - addTypeReference DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 Scanning DeadValueTest.cmt Source:DeadValueTest.res addValueDeclaration +valueAlive DeadValueTest.res:1:4 path:+DeadValueTest addValueDeclaration +valueDead DeadValueTest.res:2:4 path:+DeadValueTest @@ -388,15 +388,15 @@ Scanning FirstClassModulesInterface.cmti Source:FirstClassModulesInterface.resi addRecordLabelDeclaration x FirstClassModulesInterface.resi:3:2 path:FirstClassModulesInterface.record extendTypeDependencies FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 + addTypeReference FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 extendTypeDependencies FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + addTypeReference FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 addRecordLabelDeclaration y FirstClassModulesInterface.resi:4:2 path:FirstClassModulesInterface.record extendTypeDependencies FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 + addTypeReference FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 extendTypeDependencies FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 - addValueDeclaration +r FirstClassModulesInterface.resi:7:0 path:FirstClassModulesInterface addTypeReference FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 - addTypeReference FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 - addTypeReference FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 - addTypeReference FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + addValueDeclaration +r FirstClassModulesInterface.resi:7:0 path:FirstClassModulesInterface Scanning Hooks.cmt Source:Hooks.res addValueDeclaration +make Hooks.res:4:4 path:+Hooks addValueDeclaration +default Hooks.res:25:4 path:+Hooks @@ -994,9 +994,9 @@ Scanning InnerModuleTypes.cmti Source:InnerModuleTypes.resi addVariantCaseDeclaration Foo InnerModuleTypes.resi:2:11 path:InnerModuleTypes.I.t extendTypeDependencies InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 + addTypeReference InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 extendTypeDependencies InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 addTypeReference InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 - addTypeReference InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 Scanning JSResource.cmt Source:JSResource.res Scanning JsxV4.cmt Source:JsxV4.res addValueDeclaration +make JsxV4.res:4:23 path:+JsxV4.C From da9ba2fd25a35c23ccbf583ed4e859090ad51c7d Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 05:23:47 +0100 Subject: [PATCH 03/12] reanalyze: remove global TypeLabels table (pure) Stop using a global TypeLabels hashtable during AST processing. Instead, compute type-label dependencies in a post-merge pass from merged Declarations and add the corresponding type-reference edges before solving. Fix: use raw decl positions (not declGetLoc/posAdjustment) when building cross-file label indices, since reference graph keys are raw positions. Note: debug output in deadcode expected logs is reordered due to moving label linking from per-file traversal to the post-merge pass. Signed-Off-By: Cristiano Calcagno --- analysis/reanalyze/src/DceFileProcessing.ml | 10 +- analysis/reanalyze/src/DeadType.ml | 157 +++++++++++------- analysis/reanalyze/src/DeadValue.ml | 14 +- analysis/reanalyze/src/Reanalyze.ml | 3 + .../deadcode/expected/deadcode.txt | 148 +++++++++++------ 5 files changed, 212 insertions(+), 120 deletions(-) diff --git a/analysis/reanalyze/src/DceFileProcessing.ml b/analysis/reanalyze/src/DceFileProcessing.ml index c6e42a9c89..8b18d01aa1 100644 --- a/analysis/reanalyze/src/DceFileProcessing.ml +++ b/analysis/reanalyze/src/DceFileProcessing.ml @@ -19,8 +19,8 @@ let module_name_tagged (file : file_context) = (* ===== Signature processing ===== *) -let processSignature ~config ~decls ~refs ~(file : file_context) ~doValues - ~doTypes (signature : Types.signature) = +let processSignature ~config ~decls ~(file : file_context) ~doValues ~doTypes + (signature : Types.signature) = let dead_common_file : FileContext.t = { source_path = file.source_path; @@ -31,7 +31,7 @@ let processSignature ~config ~decls ~refs ~(file : file_context) ~doValues signature |> List.iter (fun sig_item -> DeadValue.processSignatureItem ~config ~decls ~file:dead_common_file - ~refs ~doValues ~doTypes ~moduleLoc:Location.none + ~doValues ~doTypes ~moduleLoc:Location.none ~modulePath:ModulePath.initial ~path:[module_name_tagged file] sig_item) @@ -67,7 +67,7 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath (match cmt_infos.cmt_annots with | Interface signature -> CollectAnnotations.signature ~state:annotations ~config signature; - processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:true + processSignature ~config ~decls ~file ~doValues:true ~doTypes:true signature.sig_type | Implementation structure -> let cmtiExists = @@ -75,7 +75,7 @@ let process_cmt_file ~config ~(file : file_context) ~cmtFilePath in CollectAnnotations.structure ~state:annotations ~config ~doGenType:(not cmtiExists) structure; - processSignature ~config ~decls ~refs ~file ~doValues:true ~doTypes:false + processSignature ~config ~decls ~file ~doValues:true ~doTypes:false structure.str_type; let doExternals = false in DeadValue.processStructure ~config ~decls ~refs ~file_deps ~cross_file diff --git a/analysis/reanalyze/src/DeadType.ml b/analysis/reanalyze/src/DeadType.ml index cc3bc7401a..3eef8de0c5 100644 --- a/analysis/reanalyze/src/DeadType.ml +++ b/analysis/reanalyze/src/DeadType.ml @@ -2,14 +2,6 @@ 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) @@ -26,49 +18,7 @@ let extendTypeDependencies ~config ~refs (loc1 : Location.t) (loc2 : Location.t) (posFrom |> Pos.toString); addTypeReference ~config ~refs ~posFrom ~posTo) -(* Type dependencies between Foo.re and Foo.rei *) -let addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc - ~typeLabelName = - 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 ~refs loc loc2; - if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config ~refs loc2 loc) - | Some loc1 -> - extendTypeDependencies ~config ~refs loc loc1; - if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config ~refs 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 ~refs loc1 loc; - if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config ~refs loc loc1 - -(* Add type dependencies between implementation and interface in inner module *) -let addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName - = - let path = typeLabelName :: pathToType in - match TypeLabels.find path with - | Some loc2 -> - extendTypeDependencies ~config ~refs loc loc2; - if not Config.reportTypesDeadOnlyInInterface then - extendTypeDependencies ~config ~refs loc2 loc - | None -> TypeLabels.add path loc - -let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t) +let addDeclaration ~config ~decls ~file ~(modulePath : ModulePath.t) ~(typeId : Ident.t) ~(typeKind : Types.type_kind) = let pathToType = (typeId |> Ident.name |> Name.create) @@ -77,11 +27,7 @@ let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.t) let processTypeLabel ?(posAdjustment = Decl.Nothing) typeLabelName ~declKind ~(loc : Location.t) = addDeclaration_ ~config ~decls ~file ~declKind ~path:pathToType ~loc - ~moduleLoc:modulePath.loc ~posAdjustment typeLabelName; - addTypeDependenciesAcrossFiles ~config ~refs ~file ~pathToType ~loc - ~typeLabelName; - addTypeDependenciesInnerModule ~config ~refs ~pathToType ~loc ~typeLabelName; - TypeLabels.add (typeLabelName :: pathToType) loc + ~moduleLoc:modulePath.loc ~posAdjustment typeLabelName in match typeKind with | Type_record (l, _) -> @@ -118,3 +64,102 @@ let addDeclaration ~config ~decls ~refs ~file ~(modulePath : ModulePath.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 diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 3f57c51e40..a6c266e264 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -242,12 +242,12 @@ let rec getSignature (moduleType : Types.module_type) = | Mty_functor (_, _mtParam, mt) -> getSignature mt | _ -> [] -let rec processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues - ~moduleLoc ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) = +let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc + ~(modulePath : ModulePath.t) ~path (si : Types.signature_item) = match si with | Sig_type (id, t, _) when doTypes -> if !Config.analyzeTypes then - DeadType.addDeclaration ~config ~decls ~refs ~file ~modulePath ~typeId:id + DeadType.addDeclaration ~config ~decls ~file ~modulePath ~typeId:id ~typeKind:t.type_kind | Sig_value (id, {Types.val_loc = loc; val_kind = kind; val_type}) when doValues -> @@ -283,7 +283,7 @@ let rec processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues if collect then getSignature moduleType |> List.iter - (processSignatureItem ~config ~decls ~refs ~file ~doTypes ~doValues + (processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc ~modulePath:modulePath' ~path:((id |> Ident.name |> Name.create) :: path)) | _ -> () @@ -323,7 +323,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes | Mty_signature signature -> signature |> List.iter - (processSignatureItem ~config ~decls ~refs ~file ~doTypes + (processSignatureItem ~config ~decls ~file ~doTypes ~doValues:false ~moduleLoc:mb_expr.mod_loc ~modulePath:modulePath' ~path: @@ -361,7 +361,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes typeDeclarations |> List.iter (fun (typeDeclaration : Typedtree.type_declaration) -> - DeadType.addDeclaration ~config ~decls ~refs ~file + DeadType.addDeclaration ~config ~decls ~file ~modulePath ~typeId:typeDeclaration.typ_id ~typeKind:typeDeclaration.typ_type.type_kind); None @@ -373,7 +373,7 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes in incl_type |> List.iter - (processSignatureItem ~config ~decls ~refs ~file ~doTypes + (processSignatureItem ~config ~decls ~file ~doTypes ~doValues:false (* TODO: also values? *) ~moduleLoc:incl_mod.mod_loc ~modulePath ~path:currentPath) diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index cb5d70b121..efaf8157ec 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -164,6 +164,9 @@ let runAnalysis ~dce_config ~cmtRoot = ~into:refs_builder; FileDeps.merge_into_builder ~from:fd.DceFileProcessing.file_deps ~into:file_deps_builder); + (* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *) + DeadType.process_type_label_dependencies ~config:dce_config ~decls + ~refs:refs_builder; (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) CrossFileItems.process_exception_refs cross_file ~refs:refs_builder ~file_deps:file_deps_builder ~find_exception:DeadException.find_exception diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 376237d948..f2dacf6bf8 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -66,15 +66,7 @@ addTypeReference DeadRT.res:11:16 --> DeadRT.res:3:2 Scanning DeadRT.cmti Source:DeadRT.resi addVariantCaseDeclaration Root DeadRT.resi:2:2 path:DeadRT.moduleAccessPath - extendTypeDependencies DeadRT.res:2:2 --> DeadRT.resi:2:2 - addTypeReference DeadRT.resi:2:2 --> DeadRT.res:2:2 - extendTypeDependencies DeadRT.resi:2:2 --> DeadRT.res:2:2 - addTypeReference DeadRT.res:2:2 --> DeadRT.resi:2:2 addVariantCaseDeclaration Kaboom DeadRT.resi:3:2 path:DeadRT.moduleAccessPath - extendTypeDependencies DeadRT.res:3:2 --> DeadRT.resi:3:2 - addTypeReference DeadRT.resi:3:2 --> DeadRT.res:3:2 - extendTypeDependencies DeadRT.resi:3:2 --> DeadRT.res:3:2 - addTypeReference DeadRT.res:3:2 --> DeadRT.resi:3:2 Scanning DeadTest.cmt Source:DeadTest.res addValueDeclaration +fortytwo DeadTest.res:2:4 path:+DeadTest addValueDeclaration +fortyTwoButExported DeadTest.res:5:4 path:+DeadTest @@ -116,10 +108,6 @@ addValueDeclaration +thisSignatureItemIsDead DeadTest.res:31:6 path:+DeadTest.M addVariantCaseDeclaration A DeadTest.res:35:11 path:+DeadTest.VariantUsedOnlyInImplementation.t addVariantCaseDeclaration A DeadTest.res:38:11 path:+DeadTest.VariantUsedOnlyInImplementation.t - extendTypeDependencies DeadTest.res:38:11 --> DeadTest.res:35:11 - addTypeReference DeadTest.res:35:11 --> DeadTest.res:38:11 - extendTypeDependencies DeadTest.res:35:11 --> DeadTest.res:38:11 - addTypeReference DeadTest.res:38:11 --> DeadTest.res:35:11 addValueDeclaration +a DeadTest.res:39:6 path:+DeadTest.VariantUsedOnlyInImplementation addTypeReference DeadTest.res:39:10 --> DeadTest.res:38:11 addValueReference DeadTest.res:42:17 --> DeadTest.res:36:2 @@ -171,10 +159,6 @@ addVariantCaseDeclaration A DeadTest.res:134:11 path:+DeadTest.WithInclude.t addVariantCaseDeclaration A DeadTest.res:137:13 path:+DeadTest.WithInclude.T.t addVariantCaseDeclaration A DeadTest.res:137:13 path:+DeadTest.WithInclude.t - extendTypeDependencies DeadTest.res:137:13 --> DeadTest.res:134:11 - addTypeReference DeadTest.res:134:11 --> DeadTest.res:137:13 - extendTypeDependencies DeadTest.res:134:11 --> DeadTest.res:137:13 - addTypeReference DeadTest.res:137:13 --> DeadTest.res:134:11 addTypeReference DeadTest.res:142:7 --> DeadTest.res:134:11 addValueDeclaration +x DeadTest.res:146:6 path:+DeadTest addValueDeclaration +y DeadTest.res:147:6 path:+DeadTest @@ -233,36 +217,12 @@ addValueReference DeadTypeTest.resi:4:0 --> DeadTypeTest.res:4:4 Scanning DeadTypeTest.cmti Source:DeadTypeTest.resi addVariantCaseDeclaration A DeadTypeTest.resi:2:2 path:DeadTypeTest.t - extendTypeDependencies DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 - addTypeReference DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 - extendTypeDependencies DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 - addTypeReference DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 addVariantCaseDeclaration B DeadTypeTest.resi:3:2 path:DeadTypeTest.t - extendTypeDependencies DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 - addTypeReference DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 - extendTypeDependencies DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 - addTypeReference DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 addValueDeclaration +a DeadTypeTest.resi:4:0 path:DeadTypeTest addVariantCaseDeclaration OnlyInImplementation DeadTypeTest.resi:7:2 path:DeadTypeTest.deadType - extendTypeDependencies DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 - addTypeReference DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 - extendTypeDependencies DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 - addTypeReference DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 addVariantCaseDeclaration OnlyInInterface DeadTypeTest.resi:8:2 path:DeadTypeTest.deadType - extendTypeDependencies DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 - addTypeReference DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 - extendTypeDependencies DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 - addTypeReference DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 addVariantCaseDeclaration InBoth DeadTypeTest.resi:9:2 path:DeadTypeTest.deadType - extendTypeDependencies DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 - addTypeReference DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 - extendTypeDependencies DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 - addTypeReference DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 addVariantCaseDeclaration InNeither DeadTypeTest.resi:10:2 path:DeadTypeTest.deadType - extendTypeDependencies DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 - addTypeReference DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 - extendTypeDependencies DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 - addTypeReference DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 Scanning DeadValueTest.cmt Source:DeadValueTest.res addValueDeclaration +valueAlive DeadValueTest.res:1:4 path:+DeadValueTest addValueDeclaration +valueDead DeadValueTest.res:2:4 path:+DeadValueTest @@ -387,15 +347,7 @@ addValueReference FirstClassModulesInterface.res:9:2 --> FirstClassModulesInterface.resi:11:2 Scanning FirstClassModulesInterface.cmti Source:FirstClassModulesInterface.resi addRecordLabelDeclaration x FirstClassModulesInterface.resi:3:2 path:FirstClassModulesInterface.record - extendTypeDependencies FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 - addTypeReference FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 - extendTypeDependencies FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 - addTypeReference FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 addRecordLabelDeclaration y FirstClassModulesInterface.resi:4:2 path:FirstClassModulesInterface.record - extendTypeDependencies FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 - addTypeReference FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 - extendTypeDependencies FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 - addTypeReference FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 addValueDeclaration +r FirstClassModulesInterface.resi:7:0 path:FirstClassModulesInterface Scanning Hooks.cmt Source:Hooks.res addValueDeclaration +make Hooks.res:4:4 path:+Hooks @@ -993,10 +945,6 @@ addVariantCaseDeclaration Foo InnerModuleTypes.res:2:11 path:+InnerModuleTypes.I.t Scanning InnerModuleTypes.cmti Source:InnerModuleTypes.resi addVariantCaseDeclaration Foo InnerModuleTypes.resi:2:11 path:InnerModuleTypes.I.t - extendTypeDependencies InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 - addTypeReference InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 - extendTypeDependencies InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 - addTypeReference InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 Scanning JSResource.cmt Source:JSResource.res Scanning JsxV4.cmt Source:JsxV4.res addValueDeclaration +make JsxV4.res:4:23 path:+JsxV4.C @@ -1759,6 +1707,102 @@ Implementation 0 Implementation 0 Implementation 0 + extendTypeDependencies DeadTest.res:38:11 --> DeadTest.res:35:11 + addTypeReference DeadTest.res:35:11 --> DeadTest.res:38:11 + extendTypeDependencies DeadTest.res:35:11 --> DeadTest.res:38:11 + addTypeReference DeadTest.res:38:11 --> DeadTest.res:35:11 + extendTypeDependencies DeadTest.res:137:13 --> DeadTest.res:134:11 + addTypeReference DeadTest.res:134:11 --> DeadTest.res:137:13 + extendTypeDependencies DeadTest.res:134:11 --> DeadTest.res:137:13 + addTypeReference DeadTest.res:137:13 --> DeadTest.res:134:11 + extendTypeDependencies DeadRT.res:2:2 --> DeadRT.resi:2:2 + addTypeReference DeadRT.resi:2:2 --> DeadRT.res:2:2 + extendTypeDependencies DeadRT.resi:2:2 --> DeadRT.res:2:2 + addTypeReference DeadRT.res:2:2 --> DeadRT.resi:2:2 + extendTypeDependencies DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 + addTypeReference DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 + extendTypeDependencies DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 + addTypeReference DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 + extendTypeDependencies InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 + addTypeReference InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 + extendTypeDependencies InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 + addTypeReference InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 + extendTypeDependencies DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 + addTypeReference DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 + extendTypeDependencies DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 + addTypeReference DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 + extendTypeDependencies DeadRT.res:3:2 --> DeadRT.resi:3:2 + addTypeReference DeadRT.resi:3:2 --> DeadRT.res:3:2 + extendTypeDependencies DeadRT.resi:3:2 --> DeadRT.res:3:2 + addTypeReference DeadRT.res:3:2 --> DeadRT.resi:3:2 + extendTypeDependencies FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 + addTypeReference FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 + extendTypeDependencies FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 + addTypeReference FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 + extendTypeDependencies InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 + addTypeReference InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 + extendTypeDependencies InnerModuleTypes.resi:2:11 --> InnerModuleTypes.res:2:11 + addTypeReference InnerModuleTypes.res:2:11 --> InnerModuleTypes.resi:2:11 + extendTypeDependencies FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 + addTypeReference FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + extendTypeDependencies FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + addTypeReference FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 + extendTypeDependencies DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 + addTypeReference DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 + extendTypeDependencies DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 + addTypeReference DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 + extendTypeDependencies FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 + addTypeReference FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + extendTypeDependencies FirstClassModulesInterface.resi:3:2 --> FirstClassModulesInterface.res:2:2 + addTypeReference FirstClassModulesInterface.res:2:2 --> FirstClassModulesInterface.resi:3:2 + extendTypeDependencies DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 + addTypeReference DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 + extendTypeDependencies DeadTypeTest.resi:7:2 --> DeadTypeTest.res:7:2 + addTypeReference DeadTypeTest.res:7:2 --> DeadTypeTest.resi:7:2 + extendTypeDependencies DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 + addTypeReference DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 + extendTypeDependencies DeadTypeTest.resi:2:2 --> DeadTypeTest.res:2:2 + addTypeReference DeadTypeTest.res:2:2 --> DeadTypeTest.resi:2:2 + extendTypeDependencies DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 + addTypeReference DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 + extendTypeDependencies DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 + addTypeReference DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 + extendTypeDependencies DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 + addTypeReference DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 + extendTypeDependencies DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 + addTypeReference DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 + extendTypeDependencies DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 + addTypeReference DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 + extendTypeDependencies DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 + addTypeReference DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 + extendTypeDependencies DeadRT.res:3:2 --> DeadRT.resi:3:2 + addTypeReference DeadRT.resi:3:2 --> DeadRT.res:3:2 + extendTypeDependencies DeadRT.resi:3:2 --> DeadRT.res:3:2 + addTypeReference DeadRT.res:3:2 --> DeadRT.resi:3:2 + extendTypeDependencies DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 + addTypeReference DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 + extendTypeDependencies DeadTypeTest.resi:8:2 --> DeadTypeTest.res:8:2 + addTypeReference DeadTypeTest.res:8:2 --> DeadTypeTest.resi:8:2 + extendTypeDependencies FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 + addTypeReference FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 + extendTypeDependencies FirstClassModulesInterface.resi:4:2 --> FirstClassModulesInterface.res:3:2 + addTypeReference FirstClassModulesInterface.res:3:2 --> FirstClassModulesInterface.resi:4:2 + extendTypeDependencies DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 + addTypeReference DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 + extendTypeDependencies DeadTypeTest.resi:3:2 --> DeadTypeTest.res:3:2 + addTypeReference DeadTypeTest.res:3:2 --> DeadTypeTest.resi:3:2 + extendTypeDependencies DeadRT.res:2:2 --> DeadRT.resi:2:2 + addTypeReference DeadRT.resi:2:2 --> DeadRT.res:2:2 + extendTypeDependencies DeadRT.resi:2:2 --> DeadRT.res:2:2 + addTypeReference DeadRT.res:2:2 --> DeadRT.resi:2:2 + extendTypeDependencies DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 + addTypeReference DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 + extendTypeDependencies DeadTypeTest.resi:10:2 --> DeadTypeTest.res:10:2 + addTypeReference DeadTypeTest.res:10:2 --> DeadTypeTest.resi:10:2 + extendTypeDependencies DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 + addTypeReference DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 + extendTypeDependencies DeadTypeTest.resi:9:2 --> DeadTypeTest.res:9:2 + addTypeReference DeadTypeTest.res:9:2 --> DeadTypeTest.resi:9:2 addValueReference TestDeadExn.res:1:7 --> DeadExn.res:1:0 File References From d63aea17134a15f45cc2afc12d7e4a06819940eb Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 05:47:25 +0100 Subject: [PATCH 04/12] reanalyze: remove global exception decl table (pure) Stop using global mutable exception declaration state during AST processing. Instead, derive a pure exception lookup from merged Declarations and use it when processing CrossFileItems exception refs. Signed-Off-By: Cristiano Calcagno --- analysis/reanalyze/src/DeadException.ml | 35 +++++++++++++++++++----- analysis/reanalyze/src/DeadException.mli | 25 +++++++++++++++++ analysis/reanalyze/src/Reanalyze.ml | 4 +-- 3 files changed, 55 insertions(+), 9 deletions(-) create mode 100644 analysis/reanalyze/src/DeadException.mli diff --git a/analysis/reanalyze/src/DeadException.ml b/analysis/reanalyze/src/DeadException.ml index 3ad2b76d35..f0b6a7f255 100644 --- a/analysis/reanalyze/src/DeadException.ml +++ b/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 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 add ~config ~decls ~file ~path ~loc ~(strLoc : Location.t) ~(moduleLoc : Location.t) name = - let exceptionPath = name :: path in - Hashtbl.add declarations exceptionPath loc; + addDeclaration_ ~config ~decls ~file ~posEnd:strLoc.loc_end + ~posStart:strLoc.loc_start ~declKind:Exception ~moduleLoc ~path ~loc name; name - |> addDeclaration_ ~config ~decls ~file ~posEnd:strLoc.loc_end - ~posStart:strLoc.loc_start ~declKind:Exception ~moduleLoc ~path ~loc - -let find_exception path = Hashtbl.find_opt declarations path let markAsUsed ~config ~refs ~file_deps ~cross_file ~(binding : Location.t) ~(locFrom : Location.t) ~(locTo : Location.t) path_ = diff --git a/analysis/reanalyze/src/DeadException.mli b/analysis/reanalyze/src/DeadException.mli new file mode 100644 index 0000000000..5988ee80eb --- /dev/null +++ b/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 diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index efaf8157ec..f9094026c2 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -167,10 +167,10 @@ let runAnalysis ~dce_config ~cmtRoot = (* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *) DeadType.process_type_label_dependencies ~config:dce_config ~decls ~refs:refs_builder; + let find_exception = DeadException.find_exception_from_decls decls in (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) CrossFileItems.process_exception_refs cross_file ~refs:refs_builder - ~file_deps:file_deps_builder ~find_exception:DeadException.find_exception - ~config:dce_config; + ~file_deps:file_deps_builder ~find_exception ~config:dce_config; (* Now freeze refs and file_deps for solver *) let refs = References.freeze_builder refs_builder in let file_deps = FileDeps.freeze_builder file_deps_builder in From cc55edd6fd9fc062d4a58e2b4e68221747eb28e8 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 06:04:42 +0100 Subject: [PATCH 05/12] Refactor Exception analysis to eliminate global mutable state - Replace global Values.valueBindingsTable with per-file values_builder - Replace global Checks.checks with per-file checks_builder - processCmt now returns file_result with per-file data - Add runChecks to process all checks after merging values tables - Update Reanalyze.ml to collect exception results and run checks at end - This enables future parallelization of AST processing --- analysis/reanalyze/src/Exception.ml | 172 ++++++++++++------ analysis/reanalyze/src/Reanalyze.ml | 65 +++++-- .../deadcode/expected/exception.txt | 16 +- 3 files changed, 167 insertions(+), 86 deletions(-) diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index 146974d650..05b821c7aa 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -1,46 +1,54 @@ open DeadCommon -module Values = struct - let valueBindingsTable = - (Hashtbl.create 15 : (string, (Name.t, Exceptions.t) Hashtbl.t) Hashtbl.t) +(** Per-file mutable builder for exception values during AST processing *) +type values_builder = (Name.t, Exceptions.t) Hashtbl.t + +(** Merged immutable table for cross-file lookups *) +type values_table = (string, (Name.t, Exceptions.t) Hashtbl.t) Hashtbl.t + +let create_values_builder () : values_builder = Hashtbl.create 15 - let currentFileTable = ref (Hashtbl.create 1) +let values_builder_add (builder : values_builder) ~modulePath ~name exceptions = + let path = (name |> Name.create) :: modulePath.ModulePath.path in + Hashtbl.replace builder (path |> DcePath.toName) exceptions - let add ~modulePath ~name exceptions = - let path = (name |> Name.create) :: modulePath.ModulePath.path in - Hashtbl.replace !currentFileTable (path |> DcePath.toName) exceptions +(** Merge all per-file builders into a single lookup table *) +let merge_values_builders (builders : (string * values_builder) list) : + values_table = + let table = Hashtbl.create 15 in + builders + |> List.iter (fun (moduleName, builder) -> + Hashtbl.replace table moduleName builder); + table - let getFromModule ~moduleName ~modulePath (path_ : DcePath.t) = +module Values = struct + let getFromModule (table : values_table) ~moduleName ~modulePath + (path_ : DcePath.t) = let name = path_ @ modulePath |> DcePath.toName in - match - Hashtbl.find_opt valueBindingsTable (String.capitalize_ascii moduleName) - with + match Hashtbl.find_opt table (String.capitalize_ascii moduleName) with | Some tbl -> Hashtbl.find_opt tbl name | None -> ( - match - Hashtbl.find_opt valueBindingsTable - (String.uncapitalize_ascii moduleName) - with + match Hashtbl.find_opt table (String.uncapitalize_ascii moduleName) with | Some tbl -> Hashtbl.find_opt tbl name | None -> None) - let rec findLocal ~moduleName ~modulePath path = - match path |> getFromModule ~moduleName ~modulePath with + let rec findLocal (table : values_table) ~moduleName ~modulePath path = + match path |> getFromModule table ~moduleName ~modulePath with | Some exceptions -> Some exceptions | None -> ( match modulePath with | [] -> None | _ :: restModulePath -> - path |> findLocal ~moduleName ~modulePath:restModulePath) + path |> findLocal table ~moduleName ~modulePath:restModulePath) - let findPath ~moduleName ~modulePath path = + let findPath (table : values_table) ~moduleName ~modulePath path = let findExternal ~externalModuleName ~pathRev = pathRev |> List.rev - |> getFromModule + |> getFromModule table ~moduleName:(externalModuleName |> Name.toString) ~modulePath:[] in - match path |> findLocal ~moduleName ~modulePath with + match path |> findLocal table ~moduleName ~modulePath with | None -> ( (* Search in another file *) match path |> List.rev with @@ -54,10 +62,6 @@ module Values = struct | None, _ -> None) | [] -> None) | Some exceptions -> Some exceptions - - let newCmt ~moduleName = - currentFileTable := Hashtbl.create 15; - Hashtbl.replace valueBindingsTable moduleName !currentFileTable end module Event = struct @@ -99,7 +103,7 @@ module Event = struct nestedEvents |> List.iter (fun e -> Format.fprintf ppf "%a " print e)) () - let combine ~config ~moduleName events = + let combine ~(values_table : values_table) ~config ~moduleName events = if config.DceConfig.cli.debug then ( Log_.item "@."; Log_.item "Events combine: #events %d@." (events |> List.length)); @@ -123,7 +127,9 @@ module Event = struct | ({kind = Call {callee; modulePath}; loc} as ev) :: rest -> if config.DceConfig.cli.debug then Log_.item "%a@." print ev; let exceptions = - match callee |> Values.findPath ~moduleName ~modulePath with + match + callee |> Values.findPath values_table ~moduleName ~modulePath + with | Some exceptions -> exceptions | _ -> ( match ExnLib.find callee with @@ -168,25 +174,33 @@ module Event = struct (exnSet, exnTable) end -module Checks = struct - type check = { - events: Event.t list; - loc: Location.t; - locFull: Location.t; - moduleName: string; - exnName: string; - exceptions: Exceptions.t; - } +(** Per-file mutable builder for checks during AST processing *) +type checks_builder = check list ref + +and check = { + events: Event.t list; + loc: Location.t; + locFull: Location.t; + moduleName: string; + exnName: string; + exceptions: Exceptions.t; +} - type t = check list +let create_checks_builder () : checks_builder = ref [] - let checks = (ref [] : t ref) +let checks_builder_add (builder : checks_builder) ~events ~exceptions ~loc + ?(locFull = loc) ~moduleName exnName = + builder := {events; exceptions; loc; locFull; moduleName; exnName} :: !builder - let add ~events ~exceptions ~loc ?(locFull = loc) ~moduleName exnName = - checks := {events; exceptions; loc; locFull; moduleName; exnName} :: !checks +let checks_builder_to_list (builder : checks_builder) : check list = + !builder |> List.rev - let doCheck ~config {events; exceptions; loc; locFull; moduleName; exnName} = - let throwSet, exnTable = events |> Event.combine ~config ~moduleName in +module Checks = struct + let doCheck ~(values_table : values_table) ~config + {events; exceptions; loc; locFull; moduleName; exnName} = + let throwSet, exnTable = + events |> Event.combine ~values_table ~config ~moduleName + in let missingAnnotations = Exceptions.diff throwSet exceptions in let redundantAnnotations = Exceptions.diff exceptions throwSet in (if not (Exceptions.isEmpty missingAnnotations) then @@ -215,13 +229,28 @@ module Checks = struct redundantAnnotations); }) - let doChecks ~config = !checks |> List.rev |> List.iter (doCheck ~config) + let doChecks ~values_table ~config (checks : check list) = + checks |> List.iter (doCheck ~values_table ~config) end -let traverseAst ~file () = +let traverseAst ~file ~values_builder ~checks_builder () = let super = Tast_mapper.default in let currentId = ref "" in let currentEvents = ref [] in + (* For local lookups during AST processing, we look up in the current file's builder *) + let findLocalExceptions ~modulePath path = + let name = path @ modulePath |> DcePath.toName in + Hashtbl.find_opt values_builder name + in + let rec findLocalPath ~modulePath path = + match path |> findLocalExceptions ~modulePath with + | Some exceptions -> Some exceptions + | None -> ( + match modulePath with + | [] -> None + | _ :: restModulePath -> + path |> findLocalPath ~modulePath:restModulePath) + in let exceptionsOfPatterns patterns = patterns |> List.fold_left @@ -394,7 +423,7 @@ let traverseAst ~file () = currentEvents := []; let moduleName = file.FileContext.module_name in self.expr self expr |> ignore; - Checks.add ~events:!currentEvents + checks_builder_add checks_builder ~events:!currentEvents ~exceptions:(getExceptionsFromAnnotations attributes) ~loc:expr.exp_loc ~moduleName name; currentId := oldId; @@ -416,19 +445,18 @@ let traverseAst ~file () = let exceptionsFromAnnotations = getExceptionsFromAnnotations vb.vb_attributes in - exceptionsFromAnnotations |> Values.add ~modulePath ~name; + values_builder_add values_builder ~modulePath ~name + exceptionsFromAnnotations; let res = super.value_binding self vb in let moduleName = file.FileContext.module_name in let path = [name |> Name.create] in let exceptions = - match - path |> Values.findPath ~moduleName ~modulePath:modulePath.path - with + match path |> findLocalPath ~modulePath:modulePath.path with | Some exceptions -> exceptions | _ -> Exceptions.empty in - Checks.add ~events:!currentEvents ~exceptions ~loc:vb.vb_pat.pat_loc - ~locFull:vb.vb_loc ~moduleName name; + checks_builder_add checks_builder ~events:!currentEvents ~exceptions + ~loc:vb.vb_pat.pat_loc ~locFull:vb.vb_loc ~moduleName name; currentId := oldId; currentEvents := oldEvents; res @@ -509,14 +537,42 @@ let traverseAst ~file () = fun (structure : Typedtree.structure) -> process_structure ModulePath.initial structure -let processStructure ~file (structure : Typedtree.structure) = - let process = traverseAst ~file () in +(** Result of processing a single file *) +type file_result = { + module_name: string; + values_builder: values_builder; + checks: check list; +} + +let processStructure ~file ~values_builder ~checks_builder + (structure : Typedtree.structure) = + let process = traverseAst ~file ~values_builder ~checks_builder () in process structure -let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) = +let processCmt ~file (cmt_infos : Cmt_format.cmt_infos) : file_result option = match cmt_infos.cmt_annots with - | Interface _ -> () + | Interface _ -> None | Implementation structure -> - Values.newCmt ~moduleName:file.FileContext.module_name; - structure |> processStructure ~file - | _ -> () + let values_builder = create_values_builder () in + let checks_builder = create_checks_builder () in + structure |> processStructure ~file ~values_builder ~checks_builder; + Some + { + module_name = file.FileContext.module_name; + values_builder; + checks = checks_builder_to_list checks_builder; + } + | _ -> None + +(** Process all accumulated checks using merged values table *) +let runChecks ~config (all_results : file_result list) = + (* Merge all values builders *) + let values_table = + all_results + |> List.map (fun r -> (r.module_name, r.values_builder)) + |> merge_values_builders + in + (* Collect all checks *) + let all_checks = all_results |> List.concat_map (fun r -> r.checks) in + (* Run checks with merged table *) + Checks.doChecks ~values_table ~config all_checks diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index f9094026c2..90b9e7454e 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -1,8 +1,14 @@ let runConfig = RunConfig.runConfig -(** Process a cmt file and return its file_data (if DCE enabled). +(** Result of processing a single cmt file *) +type cmt_file_result = { + dce_data: DceFileProcessing.file_data option; + exception_data: Exception.file_result option; +} + +(** Process a cmt file and return its results. Conceptually: map over files, then merge results. *) -let loadCmtFile ~config cmtFilePath : DceFileProcessing.file_data option = +let loadCmtFile ~config cmtFilePath : cmt_file_result option = let cmt_infos = Cmt_format.read_cmt cmtFilePath in let excludePath sourceFile = config.DceConfig.cli.exclude_paths @@ -43,7 +49,7 @@ let loadCmtFile ~config cmtFilePath : DceFileProcessing.file_data option = | true -> sourceFile |> Filename.basename | false -> sourceFile); (* Process file for DCE - return file_data *) - let file_data_opt = + let dce_data = if config.DceConfig.run.dce then Some (cmt_infos @@ -51,22 +57,39 @@ let loadCmtFile ~config cmtFilePath : DceFileProcessing.file_data option = ~cmtFilePath) else None in - if config.DceConfig.run.exception_ then - cmt_infos |> Exception.processCmt ~file:file_context; + (* Process file for Exception analysis *) + let exception_data = + if config.DceConfig.run.exception_ then + cmt_infos |> Exception.processCmt ~file:file_context + else None + in if config.DceConfig.run.termination then cmt_infos |> Arnold.processCmt ~config ~file:file_context; - file_data_opt + Some {dce_data; exception_data} | _ -> None -(** Process all cmt files and return list of file_data. +(** Result of processing all cmt files *) +type all_files_result = { + dce_data_list: DceFileProcessing.file_data list; + exception_results: Exception.file_result list; +} + +(** Process all cmt files and return results for DCE and Exception analysis. Conceptually: map process_cmt_file over all files. *) -let processCmtFiles ~config ~cmtRoot : DceFileProcessing.file_data list = +let processCmtFiles ~config ~cmtRoot : all_files_result = let ( +++ ) = Filename.concat in (* Local mutable state for collecting results - does not escape this function *) - let file_data_list = ref [] in + let dce_data_list = ref [] in + let exception_results = ref [] in let processFile cmtFilePath = match loadCmtFile ~config cmtFilePath with - | Some file_data -> file_data_list := file_data :: !file_data_list + | Some {dce_data; exception_data} -> + (match dce_data with + | Some data -> dce_data_list := data :: !dce_data_list + | None -> ()); + (match exception_data with + | Some data -> exception_results := data :: !exception_results + | None -> ()) | None -> () in (match cmtRoot with @@ -115,7 +138,7 @@ let processCmtFiles ~config ~cmtRoot : DceFileProcessing.file_data list = |> List.iter (fun cmtFile -> let cmtFilePath = Filename.concat libBsSourceDir cmtFile in processFile cmtFilePath))); - !file_data_list + {dce_data_list = !dce_data_list; exception_results = !exception_results} (* Shuffle a list using Fisher-Yates algorithm *) let shuffle_list lst = @@ -131,34 +154,36 @@ let shuffle_list lst = let runAnalysis ~dce_config ~cmtRoot = (* Map: process each file -> list of file_data *) - let file_data_list = processCmtFiles ~config:dce_config ~cmtRoot in + let {dce_data_list; exception_results} = + processCmtFiles ~config:dce_config ~cmtRoot + in (* Optionally shuffle for order-independence testing *) - let file_data_list = + let dce_data_list = if !Cli.testShuffle then ( Random.self_init (); if dce_config.DceConfig.cli.debug then Log_.item "Shuffling file order for order-independence test@."; - shuffle_list file_data_list) - else file_data_list + shuffle_list dce_data_list) + else dce_data_list in if dce_config.DceConfig.run.dce then ( (* Merge: combine all builders -> immutable data *) let annotations = FileAnnotations.merge_all - (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.annotations)) + (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.annotations)) in let decls = Declarations.merge_all - (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) + (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) in let cross_file = CrossFileItems.merge_all - (file_data_list |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) + (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) in (* Merge refs and file_deps into builders for cross-file items processing *) let refs_builder = References.create_builder () in let file_deps_builder = FileDeps.create_builder () in - file_data_list + dce_data_list |> List.iter (fun fd -> References.merge_into_builder ~from:fd.DceFileProcessing.refs ~into:refs_builder; @@ -214,7 +239,7 @@ let runAnalysis ~dce_config ~cmtRoot = |> List.iter (fun (issue : Issue.t) -> Log_.warning ~loc:issue.loc issue.description)); if dce_config.DceConfig.run.exception_ then - Exception.Checks.doChecks ~config:dce_config; + Exception.runChecks ~config:dce_config exception_results; if dce_config.DceConfig.run.termination && dce_config.DceConfig.cli.debug then Arnold.reportStats ~config:dce_config diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/exception.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/exception.txt index 0ebfeb0072..1040102cbc 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/exception.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/exception.txt @@ -1,5 +1,13 @@ + Exception Analysis + ExternalTest.res:7:5-24 + bigIntFromStringExn2 might throw JsExn (ExternalTest.res:7:35) and is not annotated with @throws(JsExn) + + Exception Analysis + ExnA.res:1:5-7 + bar might throw Not_found (ExnA.res:1:16) and is not annotated with @throws(Not_found) + Exception Analysis Exn.res:1:5-10 raises might throw Not_found (Exn.res:1:19) and is not annotated with @throws(Not_found) @@ -87,13 +95,5 @@ Exception Analysis Exn.res:151:5-21 onResultPipeWrong might throw Assert_failure (Exn.res:151:50) and is not annotated with @throws(Assert_failure) - - Exception Analysis - ExnA.res:1:5-7 - bar might throw Not_found (ExnA.res:1:16) and is not annotated with @throws(Not_found) - - Exception Analysis - ExternalTest.res:7:5-24 - bigIntFromStringExn2 might throw JsExn (ExternalTest.res:7:35) and is not annotated with @throws(JsExn) Analysis reported 24 issues (Exception Analysis:24) From 43a682d5dae51c1aa5bfeb0e12bcd399123df923 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 06:47:11 +0100 Subject: [PATCH 06/12] reanalyze: add parallel processing for CMT file analysis Add support for parallel processing of CMT files during dead code and exception analysis using OCaml 5 Domains. Features: - New -parallel N flag: process files using N domains (0 = sequential) - -parallel -1: auto-detect number of CPU cores - New -timing flag: report internal timing breakdown by phase - New benchmark infrastructure for performance testing The parallelization targets the CMT file processing phase, which is the main bottleneck (typically 75-80% of analysis time). The analysis and reporting phases remain sequential as they require merged cross-file data. Signed-Off-By: Cursor AI --- Makefile | 12 +- analysis/reanalyze/src/Cli.ml | 6 + analysis/reanalyze/src/DeadValue.ml | 7 +- analysis/reanalyze/src/Exception.ml | 11 +- analysis/reanalyze/src/Reanalyze.ml | 290 ++++++++++++------ analysis/reanalyze/src/Timing.ml | 42 +++ .../deadcode-benchmark/.gitignore | 5 + .../deadcode-benchmark/Makefile | 40 +++ .../deadcode-benchmark/generate.sh | 64 ++++ .../deadcode-benchmark/package.json | 12 + .../deadcode-benchmark/rescript.json | 22 ++ .../tests-reanalyze/deadcode/Makefile | 16 +- .../deadcode/generate-benchmark.sh | 63 ++++ .../tests-reanalyze/deadcode/test.sh | 56 +++- yarn.lock | 15 + 15 files changed, 550 insertions(+), 111 deletions(-) create mode 100644 analysis/reanalyze/src/Timing.ml create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode-benchmark/.gitignore create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile create mode 100755 tests/analysis_tests/tests-reanalyze/deadcode-benchmark/generate.sh create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode-benchmark/package.json create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode-benchmark/rescript.json create mode 100755 tests/analysis_tests/tests-reanalyze/deadcode/generate-benchmark.sh diff --git a/Makefile b/Makefile index 0b9f90faef..cd544d31a2 100644 --- a/Makefile +++ b/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 diff --git a/analysis/reanalyze/src/Cli.ml b/analysis/reanalyze/src/Cli.ml index 550244486a..240d369b18 100644 --- a/analysis/reanalyze/src/Cli.ml +++ b/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 diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index a6c266e264..4d636338c9 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -384,9 +384,10 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes modulePath.path @ [FileContext.module_name_tagged file] in let name = id |> Ident.name |> Name.create in - name - |> DeadException.add ~config ~decls ~file ~path ~loc - ~strLoc:structureItem.str_loc ~moduleLoc:modulePath.loc; + ignore + (DeadException.add ~config ~decls ~file ~path ~loc + ~strLoc:structureItem.str_loc ~moduleLoc:modulePath.loc + name); None | _ -> None in diff --git a/analysis/reanalyze/src/Exception.ml b/analysis/reanalyze/src/Exception.ml index 05b821c7aa..0cd48824b0 100644 --- a/analysis/reanalyze/src/Exception.ml +++ b/analysis/reanalyze/src/Exception.ml @@ -1,10 +1,10 @@ open DeadCommon -(** Per-file mutable builder for exception values during AST processing *) type values_builder = (Name.t, Exceptions.t) Hashtbl.t +(** Per-file mutable builder for exception values during AST processing *) -(** Merged immutable table for cross-file lookups *) type values_table = (string, (Name.t, Exceptions.t) Hashtbl.t) Hashtbl.t +(** Merged immutable table for cross-file lookups *) let create_values_builder () : values_builder = Hashtbl.create 15 @@ -174,8 +174,8 @@ module Event = struct (exnSet, exnTable) end -(** Per-file mutable builder for checks during AST processing *) type checks_builder = check list ref +(** Per-file mutable builder for checks during AST processing *) and check = { events: Event.t list; @@ -248,8 +248,7 @@ let traverseAst ~file ~values_builder ~checks_builder () = | None -> ( match modulePath with | [] -> None - | _ :: restModulePath -> - path |> findLocalPath ~modulePath:restModulePath) + | _ :: restModulePath -> path |> findLocalPath ~modulePath:restModulePath) in let exceptionsOfPatterns patterns = patterns @@ -537,12 +536,12 @@ let traverseAst ~file ~values_builder ~checks_builder () = fun (structure : Typedtree.structure) -> process_structure ModulePath.initial structure -(** Result of processing a single file *) type file_result = { module_name: string; values_builder: values_builder; checks: check list; } +(** Result of processing a single file *) let processStructure ~file ~values_builder ~checks_builder (structure : Typedtree.structure) = diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 90b9e7454e..c12dc6dc65 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -1,10 +1,10 @@ let runConfig = RunConfig.runConfig -(** Result of processing a single cmt file *) type cmt_file_result = { dce_data: DceFileProcessing.file_data option; exception_data: Exception.file_result option; } +(** Result of processing a single cmt file *) (** Process a cmt file and return its results. Conceptually: map over files, then merge results. *) @@ -68,30 +68,16 @@ let loadCmtFile ~config cmtFilePath : cmt_file_result option = Some {dce_data; exception_data} | _ -> None -(** Result of processing all cmt files *) type all_files_result = { dce_data_list: DceFileProcessing.file_data list; exception_results: Exception.file_result list; } +(** Result of processing all cmt files *) -(** Process all cmt files and return results for DCE and Exception analysis. - Conceptually: map process_cmt_file over all files. *) -let processCmtFiles ~config ~cmtRoot : all_files_result = +(** Collect all cmt file paths to process *) +let collectCmtFilePaths ~cmtRoot : string list = let ( +++ ) = Filename.concat in - (* Local mutable state for collecting results - does not escape this function *) - let dce_data_list = ref [] in - let exception_results = ref [] in - let processFile cmtFilePath = - match loadCmtFile ~config cmtFilePath with - | Some {dce_data; exception_data} -> - (match dce_data with - | Some data -> dce_data_list := data :: !dce_data_list - | None -> ()); - (match exception_data with - | Some data -> exception_results := data :: !exception_results - | None -> ()) - | None -> () - in + let paths = ref [] in (match cmtRoot with | Some root -> Cli.cmtCommand := true; @@ -111,7 +97,7 @@ let processCmtFiles ~config ~cmtRoot : all_files_result = else if Filename.check_suffix absDir ".cmt" || Filename.check_suffix absDir ".cmti" - then processFile absDir + then paths := absDir :: !paths in walkSubDirs "" | None -> @@ -137,9 +123,98 @@ let processCmtFiles ~config ~cmtRoot : all_files_result = cmtFiles |> List.sort String.compare |> List.iter (fun cmtFile -> let cmtFilePath = Filename.concat libBsSourceDir cmtFile in - processFile cmtFilePath))); + paths := cmtFilePath :: !paths))); + !paths |> List.rev + +(** Process files sequentially *) +let processFilesSequential ~config (cmtFilePaths : string list) : + all_files_result = + let dce_data_list = ref [] in + let exception_results = ref [] in + cmtFilePaths + |> List.iter (fun cmtFilePath -> + match loadCmtFile ~config cmtFilePath with + | Some {dce_data; exception_data} -> ( + (match dce_data with + | Some data -> dce_data_list := data :: !dce_data_list + | None -> ()); + match exception_data with + | Some data -> exception_results := data :: !exception_results + | None -> ()) + | None -> ()); {dce_data_list = !dce_data_list; exception_results = !exception_results} +(** Process files in parallel using OCaml 5 Domains *) +let processFilesParallel ~config ~numDomains (cmtFilePaths : string list) : + all_files_result = + let numFiles = List.length cmtFilePaths in + if numFiles = 0 then {dce_data_list = []; exception_results = []} + else + let filesArray = Array.of_list cmtFilePaths in + let numDomains = min numDomains numFiles in + (* Divide files among domains *) + let chunkSize = (numFiles + numDomains - 1) / numDomains in + (* Thread-safe results accumulator using Mutex *) + let resultsMutex = Mutex.create () in + let allDceData = ref [] in + let allExceptionData = ref [] in + let processChunk startIdx endIdx = + let localDce = ref [] in + let localExn = ref [] in + for i = startIdx to endIdx - 1 do + match loadCmtFile ~config filesArray.(i) with + | Some {dce_data; exception_data} -> ( + (match dce_data with + | Some data -> localDce := data :: !localDce + | None -> ()); + match exception_data with + | Some data -> localExn := data :: !localExn + | None -> ()) + | None -> () + done; + (* Merge local results into global results under mutex *) + Mutex.lock resultsMutex; + allDceData := !localDce @ !allDceData; + allExceptionData := !localExn @ !allExceptionData; + Mutex.unlock resultsMutex + in + (* Spawn domains for parallel processing *) + let domains = + Array.init numDomains (fun i -> + let startIdx = i * chunkSize in + let endIdx = min ((i + 1) * chunkSize) numFiles in + if startIdx < numFiles then + Some (Domain.spawn (fun () -> processChunk startIdx endIdx)) + else None) + in + (* Wait for all domains to complete *) + Array.iter + (function + | Some d -> Domain.join d + | None -> ()) + domains; + {dce_data_list = !allDceData; exception_results = !allExceptionData} + +(** Process all cmt files and return results for DCE and Exception analysis. + Conceptually: map process_cmt_file over all files. *) +let processCmtFiles ~config ~cmtRoot : all_files_result = + Timing.time_phase `CmtProcessing (fun () -> + let cmtFilePaths = collectCmtFilePaths ~cmtRoot in + let numDomains = + match !Cli.parallel with + | n when n > 0 -> n + | n when n < 0 -> + (* Auto-detect: use recommended domain count (number of cores) *) + Domain.recommended_domain_count () + | _ -> 0 + in + if numDomains > 0 then ( + if !Cli.timing then + Printf.eprintf "Using %d parallel domains for %d files\n%!" numDomains + (List.length cmtFilePaths); + processFilesParallel ~config ~numDomains cmtFilePaths) + else processFilesSequential ~config cmtFilePaths) + (* Shuffle a list using Fisher-Yates algorithm *) let shuffle_list lst = let arr = Array.of_list lst in @@ -166,91 +241,105 @@ let runAnalysis ~dce_config ~cmtRoot = shuffle_list dce_data_list) else dce_data_list in - if dce_config.DceConfig.run.dce then ( - (* Merge: combine all builders -> immutable data *) - let annotations = - FileAnnotations.merge_all - (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.annotations)) - in - let decls = - Declarations.merge_all - (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) - in - let cross_file = - CrossFileItems.merge_all - (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) - in - (* Merge refs and file_deps into builders for cross-file items processing *) - let refs_builder = References.create_builder () in - let file_deps_builder = FileDeps.create_builder () in - dce_data_list - |> List.iter (fun fd -> - References.merge_into_builder ~from:fd.DceFileProcessing.refs - ~into:refs_builder; - FileDeps.merge_into_builder ~from:fd.DceFileProcessing.file_deps - ~into:file_deps_builder); - (* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *) - DeadType.process_type_label_dependencies ~config:dce_config ~decls - ~refs:refs_builder; - let find_exception = DeadException.find_exception_from_decls decls in - (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) - CrossFileItems.process_exception_refs cross_file ~refs:refs_builder - ~file_deps:file_deps_builder ~find_exception ~config:dce_config; - (* Now freeze refs and file_deps for solver *) - let refs = References.freeze_builder refs_builder in - let file_deps = FileDeps.freeze_builder file_deps_builder in - (* Run the solver - returns immutable AnalysisResult.t. - Optional-args checks are done in a separate pass after liveness is known. *) - let empty_optional_args_state = OptionalArgsState.create () in - let analysis_result_core = - DeadCommon.solveDead ~annotations ~decls ~refs ~file_deps - ~optional_args_state:empty_optional_args_state ~config:dce_config - ~checkOptionalArg:(fun - ~optional_args_state:_ ~annotations:_ ~config:_ _ -> []) - in - (* Compute liveness-aware optional args state *) - let is_live pos = - match Declarations.find_opt decls pos with - | Some decl -> Decl.isLive decl - | None -> true - in - let optional_args_state = - CrossFileItems.compute_optional_args_state cross_file ~decls ~is_live - in - (* Collect optional args issues only for live declarations *) - let optional_args_issues = - Declarations.fold - (fun _pos decl acc -> - if Decl.isLive decl then - let issues = - DeadOptionalArgs.check ~optional_args_state ~annotations - ~config:dce_config decl - in - List.rev_append issues acc - else acc) - decls [] - |> List.rev - in - let analysis_result = - AnalysisResult.add_issues analysis_result_core optional_args_issues - in - (* Report all issues *) - AnalysisResult.get_issues analysis_result - |> List.iter (fun (issue : Issue.t) -> - Log_.warning ~loc:issue.loc issue.description)); - if dce_config.DceConfig.run.exception_ then - Exception.runChecks ~config:dce_config exception_results; - if dce_config.DceConfig.run.termination && dce_config.DceConfig.cli.debug then - Arnold.reportStats ~config:dce_config + (* Analysis phase: merge data and solve *) + let analysis_result = + Timing.time_phase `Analysis (fun () -> + if dce_config.DceConfig.run.dce then ( + (* Merge: combine all builders -> immutable data *) + let annotations = + FileAnnotations.merge_all + (dce_data_list + |> List.map (fun fd -> fd.DceFileProcessing.annotations)) + in + let decls = + Declarations.merge_all + (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) + in + let cross_file = + CrossFileItems.merge_all + (dce_data_list + |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) + in + (* Merge refs and file_deps into builders for cross-file items processing *) + let refs_builder = References.create_builder () in + let file_deps_builder = FileDeps.create_builder () in + dce_data_list + |> List.iter (fun fd -> + References.merge_into_builder ~from:fd.DceFileProcessing.refs + ~into:refs_builder; + FileDeps.merge_into_builder + ~from:fd.DceFileProcessing.file_deps ~into:file_deps_builder); + (* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *) + DeadType.process_type_label_dependencies ~config:dce_config ~decls + ~refs:refs_builder; + let find_exception = DeadException.find_exception_from_decls decls in + (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) + CrossFileItems.process_exception_refs cross_file ~refs:refs_builder + ~file_deps:file_deps_builder ~find_exception ~config:dce_config; + (* Now freeze refs and file_deps for solver *) + let refs = References.freeze_builder refs_builder in + let file_deps = FileDeps.freeze_builder file_deps_builder in + (* Run the solver - returns immutable AnalysisResult.t. + Optional-args checks are done in a separate pass after liveness is known. *) + let empty_optional_args_state = OptionalArgsState.create () in + let analysis_result_core = + DeadCommon.solveDead ~annotations ~decls ~refs ~file_deps + ~optional_args_state:empty_optional_args_state ~config:dce_config + ~checkOptionalArg:(fun + ~optional_args_state:_ ~annotations:_ ~config:_ _ -> []) + in + (* Compute liveness-aware optional args state *) + let is_live pos = + match Declarations.find_opt decls pos with + | Some decl -> Decl.isLive decl + | None -> true + in + let optional_args_state = + CrossFileItems.compute_optional_args_state cross_file ~decls + ~is_live + in + (* Collect optional args issues only for live declarations *) + let optional_args_issues = + Declarations.fold + (fun _pos decl acc -> + if Decl.isLive decl then + let issues = + DeadOptionalArgs.check ~optional_args_state ~annotations + ~config:dce_config decl + in + List.rev_append issues acc + else acc) + decls [] + |> List.rev + in + Some + (AnalysisResult.add_issues analysis_result_core optional_args_issues)) + else None) + in + (* Reporting phase *) + Timing.time_phase `Reporting (fun () -> + (match analysis_result with + | Some result -> + AnalysisResult.get_issues result + |> List.iter (fun (issue : Issue.t) -> + Log_.warning ~loc:issue.loc issue.description) + | None -> ()); + if dce_config.DceConfig.run.exception_ then + Exception.runChecks ~config:dce_config exception_results; + if dce_config.DceConfig.run.termination && dce_config.DceConfig.cli.debug + then Arnold.reportStats ~config:dce_config) let runAnalysisAndReport ~cmtRoot = Log_.Color.setup (); + Timing.enabled := !Cli.timing; + Timing.reset (); if !Cli.json then EmitJson.start (); let dce_config = DceConfig.current () in runAnalysis ~dce_config ~cmtRoot; Log_.Stats.report ~config:dce_config; Log_.Stats.clear (); - if !Cli.json then EmitJson.finish () + if !Cli.json then EmitJson.finish (); + Timing.report () let cli () = let analysisKindSet = ref false in @@ -356,6 +445,11 @@ let cli () = Set Cli.testShuffle, "Test flag: shuffle file processing order to verify order-independence" ); + ( "-parallel", + Int (fun n -> Cli.parallel := n), + "n Process files in parallel using n domains (0 = sequential, default; \ + -1 = auto-detect cores)" ); + ("-timing", Set Cli.timing, "Report internal timing of analysis phases"); ("-version", Unit versionAndExit, "Show version information and exit"); ("--version", Unit versionAndExit, "Show version information and exit"); ] diff --git a/analysis/reanalyze/src/Timing.ml b/analysis/reanalyze/src/Timing.ml new file mode 100644 index 0000000000..3ae05e4162 --- /dev/null +++ b/analysis/reanalyze/src/Timing.ml @@ -0,0 +1,42 @@ +(** Timing utilities for measuring analysis phases *) + +let enabled = ref false + +type phase_times = { + mutable cmt_processing: float; + mutable analysis: float; + mutable reporting: float; +} + +let times = {cmt_processing = 0.0; analysis = 0.0; reporting = 0.0} + +let reset () = + times.cmt_processing <- 0.0; + times.analysis <- 0.0; + times.reporting <- 0.0 + +let now () = Unix.gettimeofday () + +let time_phase phase_name f = + if !enabled then ( + let start = now () in + let result = f () in + let elapsed = now () -. start in + (match phase_name with + | `CmtProcessing -> times.cmt_processing <- times.cmt_processing +. elapsed + | `Analysis -> times.analysis <- times.analysis +. elapsed + | `Reporting -> times.reporting <- times.reporting +. elapsed); + result) + else f () + +let report () = + if !enabled then ( + let total = times.cmt_processing +. times.analysis +. times.reporting in + Printf.eprintf "\n=== Timing ===\n"; + Printf.eprintf " CMT processing: %.3fs (%.1f%%)\n" times.cmt_processing + (100.0 *. times.cmt_processing /. total); + Printf.eprintf " Analysis: %.3fs (%.1f%%)\n" times.analysis + (100.0 *. times.analysis /. total); + Printf.eprintf " Reporting: %.3fs (%.1f%%)\n" times.reporting + (100.0 *. times.reporting /. total); + Printf.eprintf " Total: %.3fs\n" total) diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/.gitignore b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/.gitignore new file mode 100644 index 0000000000..67430b4911 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/.gitignore @@ -0,0 +1,5 @@ +# Generated files - don't commit +src/ +lib/ +node_modules/ + diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile new file mode 100644 index 0000000000..139af60221 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile @@ -0,0 +1,40 @@ +SHELL = /bin/bash + +# Number of copies to generate (default 50 = ~5000 files) +COPIES ?= 50 + +generate: + chmod +x generate.sh + ./generate.sh $(COPIES) + +node_modules/.bin/rescript: + yarn install + +build: node_modules/.bin/rescript + yarn build + +clean: + rm -rf src lib node_modules + +# Full benchmark: generate, build, then time analysis +benchmark: generate build + @echo "" + @echo "=== Benchmark: $(COPIES) copies (~$$(find src -name '*.res' | wc -l) files) ===" + @echo "" + @echo "Sequential:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @echo "" + @echo "Parallel (auto-detect cores):" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + +# Just time analysis (assumes already built) +time: + @echo "Sequential:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @echo "" + @echo "Parallel (auto-detect cores):" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + +.DEFAULT_GOAL := benchmark + +.PHONY: generate build clean benchmark time diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/generate.sh b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/generate.sh new file mode 100755 index 0000000000..a5d33515d9 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/generate.sh @@ -0,0 +1,64 @@ +#!/bin/bash +# Generate benchmark source files by replicating the deadcode test files +# Usage: ./generate.sh [num_copies] + +set -e + +NUM_COPIES=${1:-10} +SRC_DIR="../deadcode/src" +DEST_DIR="src" + +echo "Generating benchmark with $NUM_COPIES copies..." + +rm -rf "$DEST_DIR" +mkdir -p "$DEST_DIR" "$DEST_DIR/exception" + +# Collect module names into a file +MODULES_FILE="/tmp/modules_$$" +find "$SRC_DIR" \( -name "*.res" -o -name "*.resi" \) | while read f; do + filename=$(basename "$f") + echo "${filename%.*}" +done | sort -u > "$MODULES_FILE" + +NUM_MODULES=$(wc -l < "$MODULES_FILE") +echo "Found $NUM_MODULES unique modules" + +# Generate perl script template +PERL_TEMPLATE="/tmp/gen_$$.pl" + +for n in $(seq 1 $NUM_COPIES); do + echo -n "Copy $n: " + + # Build perl script for this copy number + { + echo 'while () {' + while read mod; do + echo " s/(? "$PERL_TEMPLATE" + + # Process main source files + for f in $(find "$SRC_DIR" -maxdepth 1 \( -name "*.res" -o -name "*.resi" \)); do + filename=$(basename "$f") + ext="${filename##*.}" + base="${filename%.*}" + perl "$PERL_TEMPLATE" < "$f" > "$DEST_DIR/${base}_${n}.${ext}" + done + + # Process exception files + for f in $(find "$SRC_DIR/exception" \( -name "*.res" -o -name "*.resi" \) 2>/dev/null); do + filename=$(basename "$f") + ext="${filename##*.}" + base="${filename%.*}" + perl "$PERL_TEMPLATE" < "$f" > "$DEST_DIR/exception/${base}_${n}.${ext}" + done + + echo "done" +done + +rm -f "$MODULES_FILE" "$PERL_TEMPLATE" +total=$(find "$DEST_DIR" \( -name "*.res" -o -name "*.resi" \) | wc -l) +echo "Generated $total files" + diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/package.json b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/package.json new file mode 100644 index 0000000000..fc8d9b2b70 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/package.json @@ -0,0 +1,12 @@ +{ + "name": "@tests/reanalyze-benchmark", + "private": true, + "scripts": { + "build": "rescript-legacy build", + "clean": "rescript-legacy clean" + }, + "dependencies": { + "@rescript/react": "link:../../../dependencies/rescript-react", + "rescript": "workspace:^" + } +} diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/rescript.json b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/rescript.json new file mode 100644 index 0000000000..29318160d8 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/rescript.json @@ -0,0 +1,22 @@ +{ + "reanalyze": { + "analysis": ["dce"], + "suppress": [], + "unsuppress": [], + "transitive": true + }, + "name": "reanalyze-benchmark", + "jsx": { "version": 4 }, + "dependencies": ["@rescript/react"], + "sources": [ + { + "dir": "src", + "subdirs": true + } + ], + "package-specs": { + "module": "esmodule", + "in-source": false + }, + "suffix": ".res.js" +} diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/Makefile b/tests/analysis_tests/tests-reanalyze/deadcode/Makefile index 3257028f91..eb123215d7 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/Makefile +++ b/tests/analysis_tests/tests-reanalyze/deadcode/Makefile @@ -11,9 +11,23 @@ test: build node_modules/.bin/rescript test-reanalyze-order-independence: build node_modules/.bin/rescript ./test-order-independence.sh +# Parallel mode test - runs same tests but with parallel processing +test-parallel: build node_modules/.bin/rescript + PARALLEL=4 ./test.sh + +# Benchmark: time analysis on existing compiled files +benchmark: build + @echo "=== Benchmark on existing test files ===" + @echo "" + @echo "Sequential:" + @time dune exec rescript-editor-analysis -- reanalyze -config -ci 2>/dev/null | grep "Analysis reported" + @echo "" + @echo "Parallel (4 domains):" + @time dune exec rescript-editor-analysis -- reanalyze -config -ci -parallel 4 2>/dev/null | grep "Analysis reported" + clean: yarn clean .DEFAULT_GOAL := build -.PHONY: build clean test test-reanalyze-order-independence +.PHONY: build clean test test-reanalyze-order-independence test-parallel benchmark diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/generate-benchmark.sh b/tests/analysis_tests/tests-reanalyze/deadcode/generate-benchmark.sh new file mode 100755 index 0000000000..c3b01dfd83 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode/generate-benchmark.sh @@ -0,0 +1,63 @@ +#!/bin/bash +# Generate a larger test codebase by replicating existing files +# Usage: ./generate-benchmark.sh [num_copies] + +set -e + +NUM_COPIES=${1:-10} +SRC_DIR="src" +DEST_DIR="src-benchmark" + +echo "Generating benchmark with $NUM_COPIES copies..." + +rm -rf "$DEST_DIR" +mkdir -p "$DEST_DIR" "$DEST_DIR/exception" + +# Collect module names into a file (faster than array) +MODULES_FILE="/tmp/modules_$$" +find "$SRC_DIR" \( -name "*.res" -o -name "*.resi" \) | while read f; do + filename=$(basename "$f") + echo "${filename%.*}" +done | sort -u > "$MODULES_FILE" + +NUM_MODULES=$(wc -l < "$MODULES_FILE") +echo "Found $NUM_MODULES unique modules" + +# Generate perl script template +PERL_TEMPLATE="/tmp/gen_$$.pl" + +for n in $(seq 1 $NUM_COPIES); do + echo -n "Copy $n: " + + # Build perl script for this copy number + { + echo 'while () {' + while read mod; do + echo " s/(? "$PERL_TEMPLATE" + + # Process main source files + for f in $(find "$SRC_DIR" -maxdepth 1 \( -name "*.res" -o -name "*.resi" \)); do + filename=$(basename "$f") + ext="${filename##*.}" + base="${filename%.*}" + perl "$PERL_TEMPLATE" < "$f" > "$DEST_DIR/${base}_${n}.${ext}" + done + + # Process exception files + for f in $(find "$SRC_DIR/exception" \( -name "*.res" -o -name "*.resi" \) 2>/dev/null); do + filename=$(basename "$f") + ext="${filename##*.}" + base="${filename%.*}" + perl "$PERL_TEMPLATE" < "$f" > "$DEST_DIR/exception/${base}_${n}.${ext}" + done + + echo "done" +done + +rm -f "$MODULES_FILE" "$PERL_TEMPLATE" +total=$(find "$DEST_DIR" \( -name "*.res" -o -name "*.resi" \) | wc -l) +echo "Generated $total files" diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/test.sh b/tests/analysis_tests/tests-reanalyze/deadcode/test.sh index ea28ad7789..f17e6bb373 100755 --- a/tests/analysis_tests/tests-reanalyze/deadcode/test.sh +++ b/tests/analysis_tests/tests-reanalyze/deadcode/test.sh @@ -1,4 +1,12 @@ -output="expected/deadcode.txt" +# Optional: pass PARALLEL=n to run in parallel mode (e.g., PARALLEL=4 ./test.sh) +# In parallel mode, we skip -debug flag since debug output is order-dependent +PARALLEL_FLAG="" +DEBUG_FLAG="-debug" +if [ -n "$PARALLEL" ]; then + PARALLEL_FLAG="-parallel $PARALLEL" + DEBUG_FLAG="" +fi + if [ "$RUNNER_OS" == "Windows" ]; then exclude_dirs="src\exception" suppress="src\ToSuppress.res" @@ -6,7 +14,51 @@ else exclude_dirs="src/exception" suppress="src/ToSuppress.res" fi -dune exec rescript-editor-analysis -- reanalyze -config -debug -ci -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress > $output + +# For parallel mode, compare only the analysis summary line (issue counts) +if [ -n "$PARALLEL" ]; then + # Run parallel analysis + dune exec rescript-editor-analysis -- reanalyze -config -ci -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress $PARALLEL_FLAG 2>/dev/null > /tmp/parallel-deadcode.txt + + # Extract the summary line (Analysis reported N issues...) + expected_summary=$(grep "Analysis reported" expected/deadcode.txt) + parallel_summary=$(grep "Analysis reported" /tmp/parallel-deadcode.txt) + + if [ "$expected_summary" = "$parallel_summary" ]; then + printf "\033[0;32m✅ Parallel DCE produces identical issue counts: $parallel_summary\033[0m\n" + else + printf "\033[0;33m⚠️ Parallel DCE produced different results!\033[0m\n" + echo "Expected: $expected_summary" + echo "Got: $parallel_summary" + exit 1 + fi + + # Also run exception analysis in parallel + if [ "$RUNNER_OS" == "Windows" ]; then + unsuppress_dirs="src\exception" + else + unsuppress_dirs="src/exception" + fi + dune exec rescript-editor-analysis -- reanalyze -exception -ci -suppress src -unsuppress $unsuppress_dirs $PARALLEL_FLAG 2>/dev/null > /tmp/parallel-exception.txt + + expected_summary=$(grep "Analysis reported" expected/exception.txt) + parallel_summary=$(grep "Analysis reported" /tmp/parallel-exception.txt) + + if [ "$expected_summary" = "$parallel_summary" ]; then + printf "\033[0;32m✅ Parallel exception analysis produces identical issue counts: $parallel_summary\033[0m\n" + else + printf "\033[0;33m⚠️ Parallel exception analysis produced different results!\033[0m\n" + echo "Expected: $expected_summary" + echo "Got: $parallel_summary" + exit 1 + fi + + exit 0 +fi + +# Sequential mode - generate expected files +output="expected/deadcode.txt" +dune exec rescript-editor-analysis -- reanalyze -config $DEBUG_FLAG -ci -exclude-paths $exclude_dirs -live-names globallyLive1 -live-names globallyLive2,globallyLive3 -suppress $suppress > $output # CI. We use LF, and the CI OCaml fork prints CRLF. Convert. if [ "$RUNNER_OS" == "Windows" ]; then perl -pi -e 's/\r\n/\n/g' -- $output diff --git a/yarn.lock b/yarn.lock index 81e1630eae..573bc9b2a6 100644 --- a/yarn.lock +++ b/yarn.lock @@ -412,6 +412,12 @@ __metadata: languageName: unknown linkType: soft +"@rescript/react@link:../../../dependencies/rescript-react::locator=%40tests%2Freanalyze-benchmark%40workspace%3Atests%2Fanalysis_tests%2Ftests-reanalyze%2Fdeadcode-benchmark": + version: 0.0.0-use.local + resolution: "@rescript/react@link:../../../dependencies/rescript-react::locator=%40tests%2Freanalyze-benchmark%40workspace%3Atests%2Fanalysis_tests%2Ftests-reanalyze%2Fdeadcode-benchmark" + languageName: node + linkType: soft + "@rescript/react@link:../../../dependencies/rescript-react::locator=%40tests%2Freanalyze-deadcode%40workspace%3Atests%2Fanalysis_tests%2Ftests-reanalyze%2Fdeadcode": version: 0.0.0-use.local resolution: "@rescript/react@link:../../../dependencies/rescript-react::locator=%40tests%2Freanalyze-deadcode%40workspace%3Atests%2Fanalysis_tests%2Ftests-reanalyze%2Fdeadcode" @@ -692,6 +698,15 @@ __metadata: languageName: unknown linkType: soft +"@tests/reanalyze-benchmark@workspace:tests/analysis_tests/tests-reanalyze/deadcode-benchmark": + version: 0.0.0-use.local + resolution: "@tests/reanalyze-benchmark@workspace:tests/analysis_tests/tests-reanalyze/deadcode-benchmark" + dependencies: + "@rescript/react": "link:../../../dependencies/rescript-react" + rescript: "workspace:^" + languageName: unknown + linkType: soft + "@tests/reanalyze-deadcode@workspace:tests/analysis_tests/tests-reanalyze/deadcode": version: 0.0.0-use.local resolution: "@tests/reanalyze-deadcode@workspace:tests/analysis_tests/tests-reanalyze/deadcode" From f68e752124ea13e2ef8a1224290c13ebf16a3c47 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 13 Dec 2025 06:59:08 +0100 Subject: [PATCH 07/12] reanalyze: add granular timing breakdown for analysis phases Break down timing into sub-phases: - CMT processing: - File loading: time spent reading and traversing CMT files - Result collection: time spent merging results from domains - Analysis: - Merging: combining per-file data into global structures - Solving: running the liveness solver Signed-Off-By: Cursor AI --- analysis/reanalyze/src/Reanalyze.ml | 179 +++++++++--------- analysis/reanalyze/src/Timing.ml | 56 ++++-- .../deadcode-benchmark/Makefile | 8 +- 3 files changed, 137 insertions(+), 106 deletions(-) diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index c12dc6dc65..98566fb6a4 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -129,20 +129,21 @@ let collectCmtFilePaths ~cmtRoot : string list = (** Process files sequentially *) let processFilesSequential ~config (cmtFilePaths : string list) : all_files_result = - let dce_data_list = ref [] in - let exception_results = ref [] in - cmtFilePaths - |> List.iter (fun cmtFilePath -> - match loadCmtFile ~config cmtFilePath with - | Some {dce_data; exception_data} -> ( - (match dce_data with - | Some data -> dce_data_list := data :: !dce_data_list - | None -> ()); - match exception_data with - | Some data -> exception_results := data :: !exception_results - | None -> ()) - | None -> ()); - {dce_data_list = !dce_data_list; exception_results = !exception_results} + Timing.time_phase `FileLoading (fun () -> + let dce_data_list = ref [] in + let exception_results = ref [] in + cmtFilePaths + |> List.iter (fun cmtFilePath -> + match loadCmtFile ~config cmtFilePath with + | Some {dce_data; exception_data} -> ( + (match dce_data with + | Some data -> dce_data_list := data :: !dce_data_list + | None -> ()); + match exception_data with + | Some data -> exception_results := data :: !exception_results + | None -> ()) + | None -> ()); + {dce_data_list = !dce_data_list; exception_results = !exception_results}) (** Process files in parallel using OCaml 5 Domains *) let processFilesParallel ~config ~numDomains (cmtFilePaths : string list) : @@ -178,42 +179,43 @@ let processFilesParallel ~config ~numDomains (cmtFilePaths : string list) : allExceptionData := !localExn @ !allExceptionData; Mutex.unlock resultsMutex in - (* Spawn domains for parallel processing *) - let domains = - Array.init numDomains (fun i -> - let startIdx = i * chunkSize in - let endIdx = min ((i + 1) * chunkSize) numFiles in - if startIdx < numFiles then - Some (Domain.spawn (fun () -> processChunk startIdx endIdx)) - else None) - in - (* Wait for all domains to complete *) - Array.iter - (function - | Some d -> Domain.join d - | None -> ()) - domains; + (* Time the overall parallel processing *) + Timing.time_phase `FileLoading (fun () -> + (* Spawn domains for parallel processing *) + let domains = + Array.init numDomains (fun i -> + let startIdx = i * chunkSize in + let endIdx = min ((i + 1) * chunkSize) numFiles in + if startIdx < numFiles then + Some (Domain.spawn (fun () -> processChunk startIdx endIdx)) + else None) + in + (* Wait for all domains to complete *) + Array.iter + (function + | Some d -> Domain.join d + | None -> ()) + domains); {dce_data_list = !allDceData; exception_results = !allExceptionData} (** Process all cmt files and return results for DCE and Exception analysis. Conceptually: map process_cmt_file over all files. *) let processCmtFiles ~config ~cmtRoot : all_files_result = - Timing.time_phase `CmtProcessing (fun () -> - let cmtFilePaths = collectCmtFilePaths ~cmtRoot in - let numDomains = - match !Cli.parallel with - | n when n > 0 -> n - | n when n < 0 -> - (* Auto-detect: use recommended domain count (number of cores) *) - Domain.recommended_domain_count () - | _ -> 0 - in - if numDomains > 0 then ( - if !Cli.timing then - Printf.eprintf "Using %d parallel domains for %d files\n%!" numDomains - (List.length cmtFilePaths); - processFilesParallel ~config ~numDomains cmtFilePaths) - else processFilesSequential ~config cmtFilePaths) + let cmtFilePaths = collectCmtFilePaths ~cmtRoot in + let numDomains = + match !Cli.parallel with + | n when n > 0 -> n + | n when n < 0 -> + (* Auto-detect: use recommended domain count (number of cores) *) + Domain.recommended_domain_count () + | _ -> 0 + in + if numDomains > 0 then ( + if !Cli.timing then + Printf.eprintf "Using %d parallel domains for %d files\n%!" numDomains + (List.length cmtFilePaths); + processFilesParallel ~config ~numDomains cmtFilePaths) + else processFilesSequential ~config cmtFilePaths (* Shuffle a list using Fisher-Yates algorithm *) let shuffle_list lst = @@ -243,44 +245,47 @@ let runAnalysis ~dce_config ~cmtRoot = in (* Analysis phase: merge data and solve *) let analysis_result = - Timing.time_phase `Analysis (fun () -> - if dce_config.DceConfig.run.dce then ( - (* Merge: combine all builders -> immutable data *) - let annotations = - FileAnnotations.merge_all - (dce_data_list - |> List.map (fun fd -> fd.DceFileProcessing.annotations)) - in - let decls = - Declarations.merge_all - (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) - in - let cross_file = - CrossFileItems.merge_all - (dce_data_list - |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) - in - (* Merge refs and file_deps into builders for cross-file items processing *) - let refs_builder = References.create_builder () in - let file_deps_builder = FileDeps.create_builder () in - dce_data_list - |> List.iter (fun fd -> - References.merge_into_builder ~from:fd.DceFileProcessing.refs - ~into:refs_builder; - FileDeps.merge_into_builder - ~from:fd.DceFileProcessing.file_deps ~into:file_deps_builder); - (* Compute type-label dependencies after merge (no global TypeLabels table during traversal) *) - DeadType.process_type_label_dependencies ~config:dce_config ~decls - ~refs:refs_builder; - let find_exception = DeadException.find_exception_from_decls decls in - (* Process cross-file exception refs - they write to refs_builder and file_deps_builder *) - CrossFileItems.process_exception_refs cross_file ~refs:refs_builder - ~file_deps:file_deps_builder ~find_exception ~config:dce_config; - (* Now freeze refs and file_deps for solver *) - let refs = References.freeze_builder refs_builder in - let file_deps = FileDeps.freeze_builder file_deps_builder in - (* Run the solver - returns immutable AnalysisResult.t. - Optional-args checks are done in a separate pass after liveness is known. *) + if dce_config.DceConfig.run.dce then ( + (* Merging phase: combine all builders -> immutable data *) + let annotations, decls, cross_file, refs, file_deps = + Timing.time_phase `Merging (fun () -> + let annotations = + FileAnnotations.merge_all + (dce_data_list + |> List.map (fun fd -> fd.DceFileProcessing.annotations)) + in + let decls = + Declarations.merge_all + (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) + in + let cross_file = + CrossFileItems.merge_all + (dce_data_list + |> List.map (fun fd -> fd.DceFileProcessing.cross_file)) + in + (* Merge refs and file_deps into builders for cross-file items processing *) + let refs_builder = References.create_builder () in + let file_deps_builder = FileDeps.create_builder () in + dce_data_list + |> List.iter (fun fd -> + References.merge_into_builder ~from:fd.DceFileProcessing.refs + ~into:refs_builder; + FileDeps.merge_into_builder + ~from:fd.DceFileProcessing.file_deps ~into:file_deps_builder); + (* Compute type-label dependencies after merge *) + DeadType.process_type_label_dependencies ~config:dce_config ~decls + ~refs:refs_builder; + let find_exception = DeadException.find_exception_from_decls decls in + (* Process cross-file exception refs *) + CrossFileItems.process_exception_refs cross_file ~refs:refs_builder + ~file_deps:file_deps_builder ~find_exception ~config:dce_config; + (* Freeze refs and file_deps for solver *) + let refs = References.freeze_builder refs_builder in + let file_deps = FileDeps.freeze_builder file_deps_builder in + (annotations, decls, cross_file, refs, file_deps)) + in + (* Solving phase: run the solver and collect issues *) + Timing.time_phase `Solving (fun () -> let empty_optional_args_state = OptionalArgsState.create () in let analysis_result_core = DeadCommon.solveDead ~annotations ~decls ~refs ~file_deps @@ -295,8 +300,7 @@ let runAnalysis ~dce_config ~cmtRoot = | None -> true in let optional_args_state = - CrossFileItems.compute_optional_args_state cross_file ~decls - ~is_live + CrossFileItems.compute_optional_args_state cross_file ~decls ~is_live in (* Collect optional args issues only for live declarations *) let optional_args_issues = @@ -312,9 +316,8 @@ let runAnalysis ~dce_config ~cmtRoot = decls [] |> List.rev in - Some - (AnalysisResult.add_issues analysis_result_core optional_args_issues)) - else None) + Some (AnalysisResult.add_issues analysis_result_core optional_args_issues))) + else None in (* Reporting phase *) Timing.time_phase `Reporting (fun () -> diff --git a/analysis/reanalyze/src/Timing.ml b/analysis/reanalyze/src/Timing.ml index 3ae05e4162..ab9b9bc44f 100644 --- a/analysis/reanalyze/src/Timing.ml +++ b/analysis/reanalyze/src/Timing.ml @@ -3,16 +3,32 @@ let enabled = ref false type phase_times = { - mutable cmt_processing: float; - mutable analysis: float; + (* CMT processing sub-phases *) + mutable file_loading: float; + mutable result_collection: float; + (* Analysis sub-phases *) + mutable merging: float; + mutable solving: float; + (* Reporting *) mutable reporting: float; } -let times = {cmt_processing = 0.0; analysis = 0.0; reporting = 0.0} +let times = { + file_loading = 0.0; + result_collection = 0.0; + merging = 0.0; + solving = 0.0; + reporting = 0.0; +} + +(* Mutex to protect timing updates from concurrent domains *) +let timing_mutex = Mutex.create () let reset () = - times.cmt_processing <- 0.0; - times.analysis <- 0.0; + times.file_loading <- 0.0; + times.result_collection <- 0.0; + times.merging <- 0.0; + times.solving <- 0.0; times.reporting <- 0.0 let now () = Unix.gettimeofday () @@ -22,21 +38,33 @@ let time_phase phase_name f = let start = now () in let result = f () in let elapsed = now () -. start in + (* Use mutex to safely update shared timing state *) + Mutex.lock timing_mutex; (match phase_name with - | `CmtProcessing -> times.cmt_processing <- times.cmt_processing +. elapsed - | `Analysis -> times.analysis <- times.analysis +. elapsed + | `FileLoading -> times.file_loading <- times.file_loading +. elapsed + | `ResultCollection -> + times.result_collection <- times.result_collection +. elapsed + | `Merging -> times.merging <- times.merging +. elapsed + | `Solving -> times.solving <- times.solving +. elapsed | `Reporting -> times.reporting <- times.reporting +. elapsed); + Mutex.unlock timing_mutex; result) else f () let report () = if !enabled then ( - let total = times.cmt_processing +. times.analysis +. times.reporting in + let cmt_total = times.file_loading +. times.result_collection in + let analysis_total = times.merging +. times.solving in + let total = cmt_total +. analysis_total +. times.reporting in Printf.eprintf "\n=== Timing ===\n"; - Printf.eprintf " CMT processing: %.3fs (%.1f%%)\n" times.cmt_processing - (100.0 *. times.cmt_processing /. total); - Printf.eprintf " Analysis: %.3fs (%.1f%%)\n" times.analysis - (100.0 *. times.analysis /. total); - Printf.eprintf " Reporting: %.3fs (%.1f%%)\n" times.reporting + Printf.eprintf " CMT processing: %.3fs (%.1f%%)\n" cmt_total + (100.0 *. cmt_total /. total); + Printf.eprintf " - File loading: %.3fs\n" times.file_loading; + Printf.eprintf " - Result collection: %.3fs\n" times.result_collection; + Printf.eprintf " Analysis: %.3fs (%.1f%%)\n" analysis_total + (100.0 *. analysis_total /. total); + Printf.eprintf " - Merging: %.3fs\n" times.merging; + Printf.eprintf " - Solving: %.3fs\n" times.solving; + Printf.eprintf " Reporting: %.3fs (%.1f%%)\n" times.reporting (100.0 *. times.reporting /. total); - Printf.eprintf " Total: %.3fs\n" total) + Printf.eprintf " Total: %.3fs\n" total) diff --git a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile index 139af60221..27b4767f0a 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile +++ b/tests/analysis_tests/tests-reanalyze/deadcode-benchmark/Makefile @@ -22,18 +22,18 @@ benchmark: generate build @echo "=== Benchmark: $(COPIES) copies (~$$(find src -name '*.res' | wc -l) files) ===" @echo "" @echo "Sequential:" - @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing|CMT processing|File loading|Result collection|Analysis:|Merging|Solving|Reporting:|Total:" @echo "" @echo "Parallel (auto-detect cores):" - @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing|CMT processing|File loading|Result collection|Analysis:|Merging|Solving|Reporting:|Total:" # Just time analysis (assumes already built) time: @echo "Sequential:" - @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing 2>&1 | grep -E "Analysis reported|=== Timing|CMT processing|File loading|Result collection|Analysis:|Merging|Solving|Reporting:|Total:" @echo "" @echo "Parallel (auto-detect cores):" - @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing ===|CMT processing|Analysis:|Reporting:|Total:" + @dune exec rescript-editor-analysis -- reanalyze -config -ci -timing -parallel -1 2>&1 | grep -E "Analysis reported|=== Timing|CMT processing|File loading|Result collection|Analysis:|Merging|Solving|Reporting:|Total:" .DEFAULT_GOAL := benchmark From ed06896f17fc07f0767c198d5abc249e3d87c778 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 15 Dec 2025 04:55:04 +0100 Subject: [PATCH 08/12] Bump minimum OCaml version from 4.14.2 to 5.0.1 - Update CI compatibility test to use OCaml 5.0.1 - Update all package dependencies in dune-project to require OCaml >= 5.0.1 - Update rescript.opam.template to require OCaml >= 5.0.1 - Remove redundant OCaml version check from syntax_benchmarks/dune --- .github/workflows/ci.yml | 2 +- dune-project | 9 ++++++--- rescript.opam.template | 2 +- tests/syntax_benchmarks/dune | 1 - 4 files changed, 8 insertions(+), 6 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 55fc3a417e..f410f55a7a 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -63,7 +63,7 @@ jobs: # Verify that the compiler still builds with the oldest OCaml version we support. - os: ubuntu-24.04 - ocaml_compiler: ocaml-variants.4.14.2+options,ocaml-option-static + ocaml_compiler: ocaml-variants.5.0.1+options,ocaml-option-static node-target: linux-x64 rust-target: x86_64-unknown-linux-musl diff --git a/dune-project b/dune-project index d8e0553c80..eb42e915a7 100644 --- a/dune-project +++ b/dune-project @@ -16,14 +16,17 @@ (package (name rescript) - (synopsis "ReScript compiler")) + (synopsis "ReScript compiler") + (depends + (ocaml + (>= 5.0.1)))) (package (name analysis) (synopsis "ReScript Analysis") (depends (ocaml - (>= 4.14)) + (>= 5.0.1)) (cppo (= 1.8.0)) dune)) @@ -33,7 +36,7 @@ (synopsis "ReScript Tools") (depends (ocaml - (>= 4.14)) + (>= 5.0.1)) (cmarkit (>= 0.3.0)) (cppo diff --git a/rescript.opam.template b/rescript.opam.template index ffc4578a2d..3aeab74698 100644 --- a/rescript.opam.template +++ b/rescript.opam.template @@ -1,5 +1,5 @@ depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.0.1"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/tests/syntax_benchmarks/dune b/tests/syntax_benchmarks/dune index ac9a3ac8c1..850b5ccb22 100644 --- a/tests/syntax_benchmarks/dune +++ b/tests/syntax_benchmarks/dune @@ -10,7 +10,6 @@ (enabled_if (and (<> %{profile} browser) - (>= %{ocaml_version} "4.14.0") (or (= %{system} macosx) ; or one of Linuxes (see https://github.com/ocaml/ocaml/issues/10613) From 818b6fd1ebce8247b2422d51c9a104ac91b0df11 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 15 Dec 2025 05:02:43 +0100 Subject: [PATCH 09/12] Fix format.sh to properly exit on errors and use opam exec - Add 'set -e' to exit immediately on errors - Use 'opam exec --' to match checkformat.sh behavior - Now make format will fail visibly instead of silently continuing when formatting fails --- analysis.opam | 2 +- analysis/reanalyze/src/Reanalyze.ml | 18 ++++++++++++------ analysis/reanalyze/src/Timing.ml | 15 ++++++++------- rescript.opam | 2 +- scripts/format.sh | 4 +++- tools.opam | 2 +- 6 files changed, 26 insertions(+), 17 deletions(-) diff --git a/analysis.opam b/analysis.opam index 228193d753..50e3fee73c 100644 --- a/analysis.opam +++ b/analysis.opam @@ -7,7 +7,7 @@ license: "LGPL-3.0-or-later" homepage: "https://github.com/rescript-lang/rescript-compiler" bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.0.1"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "odoc" {with-doc} diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index 98566fb6a4..a7bc1f217f 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -245,7 +245,7 @@ let runAnalysis ~dce_config ~cmtRoot = in (* Analysis phase: merge data and solve *) let analysis_result = - if dce_config.DceConfig.run.dce then ( + if dce_config.DceConfig.run.dce then (* Merging phase: combine all builders -> immutable data *) let annotations, decls, cross_file, refs, file_deps = Timing.time_phase `Merging (fun () -> @@ -256,7 +256,8 @@ let runAnalysis ~dce_config ~cmtRoot = in let decls = Declarations.merge_all - (dce_data_list |> List.map (fun fd -> fd.DceFileProcessing.decls)) + (dce_data_list + |> List.map (fun fd -> fd.DceFileProcessing.decls)) in let cross_file = CrossFileItems.merge_all @@ -271,11 +272,14 @@ let runAnalysis ~dce_config ~cmtRoot = References.merge_into_builder ~from:fd.DceFileProcessing.refs ~into:refs_builder; FileDeps.merge_into_builder - ~from:fd.DceFileProcessing.file_deps ~into:file_deps_builder); + ~from:fd.DceFileProcessing.file_deps + ~into:file_deps_builder); (* Compute type-label dependencies after merge *) DeadType.process_type_label_dependencies ~config:dce_config ~decls ~refs:refs_builder; - let find_exception = DeadException.find_exception_from_decls decls in + let find_exception = + DeadException.find_exception_from_decls decls + in (* Process cross-file exception refs *) CrossFileItems.process_exception_refs cross_file ~refs:refs_builder ~file_deps:file_deps_builder ~find_exception ~config:dce_config; @@ -300,7 +304,8 @@ let runAnalysis ~dce_config ~cmtRoot = | None -> true in let optional_args_state = - CrossFileItems.compute_optional_args_state cross_file ~decls ~is_live + CrossFileItems.compute_optional_args_state cross_file ~decls + ~is_live in (* Collect optional args issues only for live declarations *) let optional_args_issues = @@ -316,7 +321,8 @@ let runAnalysis ~dce_config ~cmtRoot = decls [] |> List.rev in - Some (AnalysisResult.add_issues analysis_result_core optional_args_issues))) + Some + (AnalysisResult.add_issues analysis_result_core optional_args_issues)) else None in (* Reporting phase *) diff --git a/analysis/reanalyze/src/Timing.ml b/analysis/reanalyze/src/Timing.ml index ab9b9bc44f..b7dfb19585 100644 --- a/analysis/reanalyze/src/Timing.ml +++ b/analysis/reanalyze/src/Timing.ml @@ -13,13 +13,14 @@ type phase_times = { mutable reporting: float; } -let times = { - file_loading = 0.0; - result_collection = 0.0; - merging = 0.0; - solving = 0.0; - reporting = 0.0; -} +let times = + { + file_loading = 0.0; + result_collection = 0.0; + merging = 0.0; + solving = 0.0; + reporting = 0.0; + } (* Mutex to protect timing updates from concurrent domains *) let timing_mutex = Mutex.create () diff --git a/rescript.opam b/rescript.opam index efb475eb5f..2453c2d3d3 100644 --- a/rescript.opam +++ b/rescript.opam @@ -21,7 +21,7 @@ build: [ ] ] depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.0.1"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/scripts/format.sh b/scripts/format.sh index 785a6e43a4..dac4f60aad 100755 --- a/scripts/format.sh +++ b/scripts/format.sh @@ -1,9 +1,11 @@ #!/bin/bash +set -e + shopt -s extglob echo Formatting OCaml code... -dune build @fmt --auto-promote +opam exec -- dune build @fmt --auto-promote echo Formatting ReScript code... files=$(find packages tests -type f \( -name "*.res" -o -name "*.resi" \) ! -name "syntaxErrors*" ! -name "generated_mocha_test.res" ! -path "tests/syntax_tests*" ! -path "tests/analysis_tests/tests*" ! -path "*/node_modules/*") diff --git a/tools.opam b/tools.opam index 4e31f92595..90ab86435d 100644 --- a/tools.opam +++ b/tools.opam @@ -7,7 +7,7 @@ license: "LGPL-3.0-or-later" homepage: "https://github.com/rescript-lang/rescript-compiler" bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.0.1"} "cmarkit" {>= "0.3.0"} "cppo" {= "1.8.0"} "analysis" From 452a4b1b96ba3ce6a81ef07101639feb45723f2a Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 15 Dec 2025 05:11:07 +0100 Subject: [PATCH 10/12] Update ci.yml --- .github/workflows/ci.yml | 2 +- analysis.opam | 2 +- dune-project | 6 +++--- rescript.opam | 2 +- rescript.opam.template | 2 +- tools.opam | 2 +- 6 files changed, 8 insertions(+), 8 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f410f55a7a..d18359b87e 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -63,7 +63,7 @@ jobs: # Verify that the compiler still builds with the oldest OCaml version we support. - os: ubuntu-24.04 - ocaml_compiler: ocaml-variants.5.0.1+options,ocaml-option-static + ocaml_compiler: ocaml-variants.5.0.0+options,ocaml-option-static node-target: linux-x64 rust-target: x86_64-unknown-linux-musl diff --git a/analysis.opam b/analysis.opam index 50e3fee73c..a202fba552 100644 --- a/analysis.opam +++ b/analysis.opam @@ -7,7 +7,7 @@ license: "LGPL-3.0-or-later" homepage: "https://github.com/rescript-lang/rescript-compiler" bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" depends: [ - "ocaml" {>= "5.0.1"} + "ocaml" {>= "5.0.0"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "odoc" {with-doc} diff --git a/dune-project b/dune-project index eb42e915a7..c8bb3117c5 100644 --- a/dune-project +++ b/dune-project @@ -19,14 +19,14 @@ (synopsis "ReScript compiler") (depends (ocaml - (>= 5.0.1)))) + (>= 5.0.0)))) (package (name analysis) (synopsis "ReScript Analysis") (depends (ocaml - (>= 5.0.1)) + (>= 5.0.0)) (cppo (= 1.8.0)) dune)) @@ -36,7 +36,7 @@ (synopsis "ReScript Tools") (depends (ocaml - (>= 5.0.1)) + (>= 5.0.0)) (cmarkit (>= 0.3.0)) (cppo diff --git a/rescript.opam b/rescript.opam index 2453c2d3d3..40a9251350 100644 --- a/rescript.opam +++ b/rescript.opam @@ -21,7 +21,7 @@ build: [ ] ] depends: [ - "ocaml" {>= "5.0.1"} + "ocaml" {>= "5.0.0"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/rescript.opam.template b/rescript.opam.template index 3aeab74698..e5629e01d6 100644 --- a/rescript.opam.template +++ b/rescript.opam.template @@ -1,5 +1,5 @@ depends: [ - "ocaml" {>= "5.0.1"} + "ocaml" {>= "5.0.0"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/tools.opam b/tools.opam index 90ab86435d..203f7fd753 100644 --- a/tools.opam +++ b/tools.opam @@ -7,7 +7,7 @@ license: "LGPL-3.0-or-later" homepage: "https://github.com/rescript-lang/rescript-compiler" bug-reports: "https://github.com/rescript-lang/rescript-compiler/issues" depends: [ - "ocaml" {>= "5.0.1"} + "ocaml" {>= "5.0.0"} "cmarkit" {>= "0.3.0"} "cppo" {= "1.8.0"} "analysis" From c3cbe6e0ea36436f04f93f550f46e2c1e0b63ac7 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 15 Dec 2025 05:52:06 +0100 Subject: [PATCH 11/12] reanalyze: clarify timing semantics for parallel result collection --- analysis/reanalyze/src/Reanalyze.ml | 14 +++++++++----- analysis/reanalyze/src/Timing.ml | 20 +++++++++++++++----- 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/analysis/reanalyze/src/Reanalyze.ml b/analysis/reanalyze/src/Reanalyze.ml index a7bc1f217f..006454247d 100644 --- a/analysis/reanalyze/src/Reanalyze.ml +++ b/analysis/reanalyze/src/Reanalyze.ml @@ -173,11 +173,15 @@ let processFilesParallel ~config ~numDomains (cmtFilePaths : string list) : | None -> ()) | None -> () done; - (* Merge local results into global results under mutex *) - Mutex.lock resultsMutex; - allDceData := !localDce @ !allDceData; - allExceptionData := !localExn @ !allExceptionData; - Mutex.unlock resultsMutex + (* Merge local results into global results under mutex. + Timed separately to measure time spent in (and waiting on) the + mutex-protected merge. Note: this is an aggregate across domains and + may exceed wall-clock time in parallel runs. *) + Timing.time_phase `ResultCollection (fun () -> + Mutex.lock resultsMutex; + allDceData := !localDce @ !allDceData; + allExceptionData := !localExn @ !allExceptionData; + Mutex.unlock resultsMutex) in (* Time the overall parallel processing *) Timing.time_phase `FileLoading (fun () -> diff --git a/analysis/reanalyze/src/Timing.ml b/analysis/reanalyze/src/Timing.ml index b7dfb19585..b9f739df6a 100644 --- a/analysis/reanalyze/src/Timing.ml +++ b/analysis/reanalyze/src/Timing.ml @@ -54,18 +54,28 @@ let time_phase phase_name f = let report () = if !enabled then ( - let cmt_total = times.file_loading +. times.result_collection in + (* NOTE about semantics: + - [file_loading] is treated as the WALL-CLOCK time for the overall + "CMT processing" phase (including per-file processing and any + synchronization). + - [result_collection] is an AGGREGATE metric across domains: time spent + in (and waiting on) the mutex-protected result merge/collection + section, summed across all worker domains. This may exceed wall-clock + time in parallel runs. + We do NOT add them together, otherwise we'd double-count. *) + let cmt_total = times.file_loading in let analysis_total = times.merging +. times.solving in let total = cmt_total +. analysis_total +. times.reporting in Printf.eprintf "\n=== Timing ===\n"; Printf.eprintf " CMT processing: %.3fs (%.1f%%)\n" cmt_total (100.0 *. cmt_total /. total); - Printf.eprintf " - File loading: %.3fs\n" times.file_loading; - Printf.eprintf " - Result collection: %.3fs\n" times.result_collection; + Printf.eprintf " - Wall clock: %.3fs\n" times.file_loading; + Printf.eprintf " - Result collection: %.3fms (aggregate)\n" + (1000.0 *. times.result_collection); Printf.eprintf " Analysis: %.3fs (%.1f%%)\n" analysis_total (100.0 *. analysis_total /. total); - Printf.eprintf " - Merging: %.3fs\n" times.merging; - Printf.eprintf " - Solving: %.3fs\n" times.solving; + Printf.eprintf " - Merging: %.3fms\n" (1000.0 *. times.merging); + Printf.eprintf " - Solving: %.3fms\n" (1000.0 *. times.solving); Printf.eprintf " Reporting: %.3fs (%.1f%%)\n" times.reporting (100.0 *. times.reporting /. total); Printf.eprintf " Total: %.3fs\n" total) From 8632e45cb9023edcf9fe2051925d6de672205a19 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Mon, 15 Dec 2025 14:11:39 +0100 Subject: [PATCH 12/12] Reanalyze: add parallel CMT processing (PR #8089) --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1c382a3194..940037e207 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,8 @@ #### :rocket: New Feature +- Reanalyze: add parallel processing for CMT file analysis with new `-parallel` and `-timing` flags, plus benchmark infrastructure for performance testing. https://github.com/rescript-lang/rescript/pull/8089 + #### :bug: Bug fix - Reanalyze: make optional args analysis liveness-aware, preventing false positives when functions are only called from dead code. https://github.com/rescript-lang/rescript/pull/8082