From 8c01864cef26f66ad535553d83bfcf44f8b5a5b4 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 12:20:32 +0200 Subject: [PATCH 01/18] use Eio for parllelising the find references command --- analysis/bin/dune | 2 +- analysis/src/Commands.ml | 185 +++++++++++++++++++------------------ analysis/src/References.ml | 127 ++++++++++++++++--------- analysis/src/dune | 2 +- 4 files changed, 182 insertions(+), 134 deletions(-) diff --git a/analysis/bin/dune b/analysis/bin/dune index 64c2a78156..9f9f943bfa 100644 --- a/analysis/bin/dune +++ b/analysis/bin/dune @@ -8,4 +8,4 @@ (package analysis) (modes byte exe) (name main) - (libraries analysis)) + (libraries analysis eio_main)) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index a4ac9168f5..692dc25dc9 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -178,100 +178,107 @@ let typeDefinition ~path ~pos ~debug = | Some location -> location |> Protocol.stringifyLocation) let references ~path ~pos ~debug = - let allLocs = - match Cmt.loadFullCmtFromPath ~path with - | None -> [] - | Some full -> ( - match References.getLocItem ~full ~pos ~debug with - | None -> [] - | Some locItem -> - let allReferences = References.allReferencesForLocItem ~full locItem in - allReferences - |> List.fold_left - (fun acc {References.uri = uri2; locOpt} -> - let loc = - match locOpt with - | Some loc -> loc - | None -> Uri.toTopLevelLoc uri2 - in - Protocol.stringifyLocation - {uri = Uri.toString uri2; range = Utils.cmtLocToRange loc} - :: acc) - []) - in - print_endline - (if allLocs = [] then Protocol.null - else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]") + Eio_main.run (fun env -> + let allLocs = + match Cmt.loadFullCmtFromPath ~path with + | None -> [] + | Some full -> ( + match References.getLocItem ~full ~pos ~debug with + | None -> [] + | Some locItem -> + References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full + locItem + |> List.fold_left + (fun acc {References.uri = uri2; locOpt} -> + let loc = + match locOpt with + | Some loc -> loc + | None -> Uri.toTopLevelLoc uri2 + in + Protocol.stringifyLocation + {uri = Uri.toString uri2; range = Utils.cmtLocToRange loc} + :: acc) + []) + in + print_endline + (if allLocs = [] then Protocol.null + else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]")) let rename ~path ~pos ~newName ~debug = let result = - match Cmt.loadFullCmtFromPath ~path with - | None -> Protocol.null - | Some full -> ( - match References.getLocItem ~full ~pos ~debug with - | None -> Protocol.null - | Some locItem -> - let allReferences = References.allReferencesForLocItem ~full locItem in - let referencesToToplevelModules = - allReferences - |> Utils.filterMap (fun {References.uri = uri2; locOpt} -> - if locOpt = None then Some uri2 else None) - in - let referencesToItems = - allReferences - |> Utils.filterMap (function - | {References.uri = uri2; locOpt = Some loc} -> Some (uri2, loc) - | {locOpt = None} -> None) - in - let fileRenames = - referencesToToplevelModules - |> List.map (fun uri -> - let path = Uri.toPath uri in - let dir = Filename.dirname path in - let newPath = - Filename.concat dir (newName ^ Filename.extension path) - in - let newUri = Uri.fromPath newPath in - Protocol. - { - oldUri = uri |> Uri.toString; - newUri = newUri |> Uri.toString; - }) - in - let textDocumentEdits = - let module StringMap = Misc.StringMap in - let textEditsByUri = - referencesToItems - |> List.map (fun (uri, loc) -> (Uri.toString uri, loc)) - |> List.fold_left - (fun acc (uri, loc) -> - let textEdit = + Eio_main.run (fun env -> + match Cmt.loadFullCmtFromPath ~path with + | None -> Protocol.null + | Some full -> ( + match References.getLocItem ~full ~pos ~debug with + | None -> Protocol.null + | Some locItem -> + let allReferences = + References.allReferencesForLocItem ~domain_mgr:env#domain_mgr + ~full locItem + in + let referencesToToplevelModules = + allReferences + |> Utils.filterMap (fun {References.uri = uri2; locOpt} -> + if locOpt = None then Some uri2 else None) + in + let referencesToItems = + allReferences + |> Utils.filterMap (function + | {References.uri = uri2; locOpt = Some loc} -> + Some (uri2, loc) + | {locOpt = None} -> None) + in + let fileRenames = + referencesToToplevelModules + |> List.map (fun uri -> + let path = Uri.toPath uri in + let dir = Filename.dirname path in + let newPath = + Filename.concat dir (newName ^ Filename.extension path) + in + let newUri = Uri.fromPath newPath in Protocol. - {range = Utils.cmtLocToRange loc; newText = newName} - in - match StringMap.find_opt uri acc with - | None -> StringMap.add uri [textEdit] acc - | Some prevEdits -> - StringMap.add uri (textEdit :: prevEdits) acc) - StringMap.empty - in - StringMap.fold - (fun uri edits acc -> - let textDocumentEdit = - Protocol.{textDocument = {uri; version = None}; edits} + { + oldUri = uri |> Uri.toString; + newUri = newUri |> Uri.toString; + }) + in + let textDocumentEdits = + let module StringMap = Misc.StringMap in + let textEditsByUri = + referencesToItems + |> List.map (fun (uri, loc) -> (Uri.toString uri, loc)) + |> List.fold_left + (fun acc (uri, loc) -> + let textEdit = + Protocol. + {range = Utils.cmtLocToRange loc; newText = newName} + in + match StringMap.find_opt uri acc with + | None -> StringMap.add uri [textEdit] acc + | Some prevEdits -> + StringMap.add uri (textEdit :: prevEdits) acc) + StringMap.empty in - textDocumentEdit :: acc) - textEditsByUri [] - in - let fileRenamesString = - fileRenames |> List.map Protocol.stringifyRenameFile - in - let textDocumentEditsString = - textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit - in - "[\n" - ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") - ^ "\n]") + StringMap.fold + (fun uri edits acc -> + let textDocumentEdit = + Protocol.{textDocument = {uri; version = None}; edits} + in + textDocumentEdit :: acc) + textEditsByUri [] + in + let fileRenamesString = + fileRenames |> List.map Protocol.stringifyRenameFile + in + let textDocumentEditsString = + textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit + in + "[\n" + ^ (fileRenamesString @ textDocumentEditsString + |> String.concat ",\n") + ^ "\n]")) in print_endline result diff --git a/analysis/src/References.ml b/analysis/src/References.ml index e047a2ba18..c79d1952b4 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -1,6 +1,6 @@ open SharedTypes -let debugReferences = ref true +let debugReferences = ref false let maybeLog m = if !debugReferences then Log.log ("[ref] " ^ m) let checkPos (line, char) @@ -433,7 +433,34 @@ type references = { locOpt: Location.t option; (* None: reference to a toplevel module *) } -let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = +(* Single helper for parallel work distribution over a list. *) +let parallel_map ~domain_mgr ~items ~f = + let len = List.length items in + let doms = Domain.recommended_domain_count () in + let chunk_size = max 1 (if doms <= 1 then len else (len + doms - 1) / doms) in + let rec chunks_of size lst = + if size <= 0 then [lst] + else + match lst with + | [] -> [] + | _ -> + let rec take n acc rest = + if n = 0 then (List.rev acc, rest) + else + match rest with + | [] -> (List.rev acc, []) + | x :: xs -> take (n - 1) (x :: acc) xs + in + let chunk, rest = take size [] lst in + chunk :: chunks_of size rest + in + let chunks = chunks_of chunk_size items in + Eio.Fiber.List.map + (fun chunk -> Eio.Domain_manager.run domain_mgr (fun () -> f chunk)) + chunks + |> List.concat + +let forLocalStamp ~domain_mgr ~full:{file; extra; package} stamp (tip : Tip.t) = let env = QueryEnv.fromFile file in match match tip with @@ -485,30 +512,34 @@ let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = in maybeLog ("Now checking path " ^ pathToString path); let thisModuleName = file.moduleName in - let externals = + let names = package.projectFiles |> FileSet.elements |> List.filter (fun name -> name <> file.moduleName) - |> List.map (fun moduleName -> - Cmt.fullsFromModule ~package ~moduleName - |> List.map (fun {file; extra} -> - match - Hashtbl.find_opt extra.externalReferences - thisModuleName - with - | None -> [] - | Some refs -> - let locs = - refs - |> Utils.filterMap (fun (p, t, locs) -> - if p = path && t = tip then Some locs - else None) - in - locs - |> List.map (fun loc -> - {uri = file.uri; locOpt = Some loc}))) - |> List.concat |> List.concat in - alternativeReferences @ externals) + let results = + parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> + let process_module moduleName = + Cmt.fullsFromModule ~package ~moduleName + |> List.map (fun {file; extra} -> + match + Hashtbl.find_opt extra.externalReferences + thisModuleName + with + | None -> [] + | Some refs -> + let locs = + refs + |> Utils.filterMap (fun (p, t, locs) -> + if p = path && t = tip then Some locs + else None) + in + locs + |> List.map (fun loc -> + {uri = file.uri; locOpt = Some loc})) + in + chunk |> List.map process_module |> List.concat |> List.concat) + in + alternativeReferences @ results) else ( maybeLog "Not visible"; []) @@ -517,26 +548,36 @@ let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = (locs |> List.map (fun loc -> {uri = file.uri; locOpt = Some loc})) externals) -let allReferencesForLocItem ~full:({file; package} as full) locItem = +let allReferencesForLocItem ~domain_mgr ~full:({file; package} as full) locItem + = match locItem.locType with | TopLevelModule moduleName -> let otherModulesReferences = - package.projectFiles |> FileSet.elements - |> Utils.filterMap (fun name -> - match ProcessCmt.fileForModule ~package name with - | None -> None - | Some file -> Cmt.fullFromUri ~uri:file.uri) - |> List.map (fun full -> - match Hashtbl.find_opt full.extra.fileReferences moduleName with - | None -> [] - | Some locs -> - locs |> LocationSet.elements - |> List.map (fun loc -> - { - uri = Uri.fromPath loc.Location.loc_start.pos_fname; - locOpt = Some loc; - })) - |> List.flatten + let names = package.projectFiles |> FileSet.elements in + let per_chunk = + parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> + let process_name name = + match ProcessCmt.fileForModule ~package name with + | None -> [] + | Some file -> ( + match Cmt.fullFromUri ~uri:file.uri with + | None -> [] + | Some full -> ( + match + Hashtbl.find_opt full.extra.fileReferences moduleName + with + | None -> [] + | Some locs -> + locs |> LocationSet.elements + |> List.map (fun loc -> + { + uri = Uri.fromPath loc.Location.loc_start.pos_fname; + locOpt = Some loc; + }))) + in + chunk |> List.map process_name |> List.concat) + in + per_chunk in let targetModuleReferences = match Hashtbl.find_opt package.pathsForModule moduleName with @@ -547,13 +588,13 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = in List.append targetModuleReferences otherModulesReferences | Typed (_, _, NotFound) | LModule NotFound | Constant _ -> [] - | TypeDefinition (_, _, stamp) -> forLocalStamp ~full stamp Type + | TypeDefinition (_, _, stamp) -> forLocalStamp ~domain_mgr ~full stamp Type | Typed (_, _, (LocalReference (stamp, tip) | Definition (stamp, tip))) | LModule (LocalReference (stamp, tip) | Definition (stamp, tip)) -> maybeLog ("Finding references for " ^ Uri.toString file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.toString tip); - forLocalStamp ~full stamp tip + forLocalStamp ~domain_mgr ~full stamp tip | LModule (GlobalReference (moduleName, path, tip)) | Typed (_, _, GlobalReference (moduleName, path, tip)) -> ( match ProcessCmt.fileForModule ~package moduleName with @@ -570,4 +611,4 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem = ("Finding references for (global) " ^ Uri.toString env.file.uri ^ " and stamp " ^ string_of_int stamp ^ " and tip " ^ Tip.toString tip); - forLocalStamp ~full stamp tip))) + forLocalStamp ~domain_mgr ~full stamp tip))) diff --git a/analysis/src/dune b/analysis/src/dune index c1bd828c11..5243f37b4c 100644 --- a/analysis/src/dune +++ b/analysis/src/dune @@ -2,4 +2,4 @@ (name analysis) (flags (-w "+6+26+27+32+33+39")) - (libraries unix str ext ml jsonlib syntax reanalyze)) + (libraries unix str ext ml jsonlib syntax reanalyze eio eio_main)) From 951b61d491e24741ef03aba68d7163b857ba0208 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 13:34:13 +0200 Subject: [PATCH 02/18] properly lock --- analysis/src/Commands.ml | 182 +++++++++++++++++------------------- analysis/src/Packages.ml | 30 ++++-- analysis/src/ProcessCmt.ml | 18 +++- analysis/src/SharedTypes.ml | 14 +++ 4 files changed, 134 insertions(+), 110 deletions(-) diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 692dc25dc9..6a0185657a 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -177,108 +177,96 @@ let typeDefinition ~path ~pos ~debug = | None -> Protocol.null | Some location -> location |> Protocol.stringifyLocation) -let references ~path ~pos ~debug = +(* Shared helper: collect references in parallel using Eio, like 'references'. *) +let collect_all_references_parallel ~path ~pos ~debug = Eio_main.run (fun env -> - let allLocs = - match Cmt.loadFullCmtFromPath ~path with + match Cmt.loadFullCmtFromPath ~path with + | None -> [] + | Some full -> ( + match References.getLocItem ~full ~pos ~debug with | None -> [] - | Some full -> ( - match References.getLocItem ~full ~pos ~debug with - | None -> [] - | Some locItem -> - References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full - locItem - |> List.fold_left - (fun acc {References.uri = uri2; locOpt} -> - let loc = - match locOpt with - | Some loc -> loc - | None -> Uri.toTopLevelLoc uri2 - in - Protocol.stringifyLocation - {uri = Uri.toString uri2; range = Utils.cmtLocToRange loc} - :: acc) - []) - in - print_endline - (if allLocs = [] then Protocol.null - else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]")) + | Some locItem -> + References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full + locItem)) + +let references ~path ~pos ~debug = + let allRefs = collect_all_references_parallel ~path ~pos ~debug in + let allLocs = + allRefs + |> List.fold_left + (fun acc {References.uri = uri2; locOpt} -> + let loc = + match locOpt with + | Some loc -> loc + | None -> Uri.toTopLevelLoc uri2 + in + Protocol.stringifyLocation + {uri = Uri.toString uri2; range = Utils.cmtLocToRange loc} + :: acc) + [] + in + print_endline + (if allLocs = [] then Protocol.null + else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]") let rename ~path ~pos ~newName ~debug = + let allReferences = collect_all_references_parallel ~path ~pos ~debug in + let referencesToToplevelModules = + allReferences + |> Utils.filterMap (fun {References.uri = uri2; locOpt} -> + if locOpt = None then Some uri2 else None) + in + let referencesToItems = + allReferences + |> Utils.filterMap (function + | {References.uri = uri2; locOpt = Some loc} -> Some (uri2, loc) + | {locOpt = None} -> None) + in + let fileRenames = + referencesToToplevelModules + |> List.map (fun uri -> + let path = Uri.toPath uri in + let dir = Filename.dirname path in + let newPath = + Filename.concat dir (newName ^ Filename.extension path) + in + let newUri = Uri.fromPath newPath in + Protocol. + {oldUri = uri |> Uri.toString; newUri = newUri |> Uri.toString}) + in + let textDocumentEdits = + let module StringMap = Misc.StringMap in + let textEditsByUri = + referencesToItems + |> List.map (fun (uri, loc) -> (Uri.toString uri, loc)) + |> List.fold_left + (fun acc (uri, loc) -> + let textEdit = + Protocol.{range = Utils.cmtLocToRange loc; newText = newName} + in + match StringMap.find_opt uri acc with + | None -> StringMap.add uri [textEdit] acc + | Some prevEdits -> StringMap.add uri (textEdit :: prevEdits) acc) + StringMap.empty + in + StringMap.fold + (fun uri edits acc -> + let textDocumentEdit = + Protocol.{textDocument = {uri; version = None}; edits} + in + textDocumentEdit :: acc) + textEditsByUri [] + in + let fileRenamesString = + fileRenames |> List.map Protocol.stringifyRenameFile + in + let textDocumentEditsString = + textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit + in let result = - Eio_main.run (fun env -> - match Cmt.loadFullCmtFromPath ~path with - | None -> Protocol.null - | Some full -> ( - match References.getLocItem ~full ~pos ~debug with - | None -> Protocol.null - | Some locItem -> - let allReferences = - References.allReferencesForLocItem ~domain_mgr:env#domain_mgr - ~full locItem - in - let referencesToToplevelModules = - allReferences - |> Utils.filterMap (fun {References.uri = uri2; locOpt} -> - if locOpt = None then Some uri2 else None) - in - let referencesToItems = - allReferences - |> Utils.filterMap (function - | {References.uri = uri2; locOpt = Some loc} -> - Some (uri2, loc) - | {locOpt = None} -> None) - in - let fileRenames = - referencesToToplevelModules - |> List.map (fun uri -> - let path = Uri.toPath uri in - let dir = Filename.dirname path in - let newPath = - Filename.concat dir (newName ^ Filename.extension path) - in - let newUri = Uri.fromPath newPath in - Protocol. - { - oldUri = uri |> Uri.toString; - newUri = newUri |> Uri.toString; - }) - in - let textDocumentEdits = - let module StringMap = Misc.StringMap in - let textEditsByUri = - referencesToItems - |> List.map (fun (uri, loc) -> (Uri.toString uri, loc)) - |> List.fold_left - (fun acc (uri, loc) -> - let textEdit = - Protocol. - {range = Utils.cmtLocToRange loc; newText = newName} - in - match StringMap.find_opt uri acc with - | None -> StringMap.add uri [textEdit] acc - | Some prevEdits -> - StringMap.add uri (textEdit :: prevEdits) acc) - StringMap.empty - in - StringMap.fold - (fun uri edits acc -> - let textDocumentEdit = - Protocol.{textDocument = {uri; version = None}; edits} - in - textDocumentEdit :: acc) - textEditsByUri [] - in - let fileRenamesString = - fileRenames |> List.map Protocol.stringifyRenameFile - in - let textDocumentEditsString = - textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit - in - "[\n" - ^ (fileRenamesString @ textDocumentEditsString - |> String.concat ",\n") - ^ "\n]")) + "[\n" + ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") + ^ "\n]" in print_endline result diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index bb455d925d..918bb49845 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -204,7 +204,10 @@ let findRoot ~uri packagesByRoot = let path = Uri.toPath uri in let rec loop path = if path = "/" then None - else if Hashtbl.mem packagesByRoot path then Some (`Root path) + else if + SharedTypes.StateSync.with_lock (fun () -> + Hashtbl.mem packagesByRoot path) + then Some (`Root path) else if Files.exists (Filename.concat path "rescript.json") || Files.exists (Filename.concat path "bsconfig.json") @@ -217,21 +220,28 @@ let findRoot ~uri packagesByRoot = let getPackage ~uri = let open SharedTypes in - if Hashtbl.mem state.rootForUri uri then - Some (Hashtbl.find state.packagesByRoot (Hashtbl.find state.rootForUri uri)) - else + match + SharedTypes.StateSync.with_lock (fun () -> + if Hashtbl.mem state.rootForUri uri then + let root = Hashtbl.find state.rootForUri uri in + Some (Hashtbl.find state.packagesByRoot root) + else None) + with + | Some pkg -> Some pkg + | None -> ( match findRoot ~uri state.packagesByRoot with | None -> Log.log "No root directory found"; None | Some (`Root rootPath) -> - Hashtbl.replace state.rootForUri uri rootPath; - Some - (Hashtbl.find state.packagesByRoot (Hashtbl.find state.rootForUri uri)) + SharedTypes.StateSync.with_lock (fun () -> + Hashtbl.replace state.rootForUri uri rootPath; + Some (Hashtbl.find state.packagesByRoot rootPath)) | Some (`Bs rootPath) -> ( match newBsPackage ~rootPath with | None -> None | Some package -> - Hashtbl.replace state.rootForUri uri package.rootPath; - Hashtbl.replace state.packagesByRoot package.rootPath package; - Some package) + SharedTypes.StateSync.with_lock (fun () -> + Hashtbl.replace state.rootForUri uri package.rootPath; + Hashtbl.replace state.packagesByRoot package.rootPath package; + Some package))) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index 96601f6e3b..cd42705d9a 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -773,15 +773,27 @@ let fileForCmtInfos ~moduleName ~uri | _ -> File.create moduleName uri let fileForCmt ~moduleName ~cmt ~uri = - match Hashtbl.find_opt state.cmtCache cmt with + (* Double-checked locking: fast path under lock; if missing, compute without + holding the lock, then insert under lock if still absent. *) + match + SharedTypes.StateSync.with_lock (fun () -> + Hashtbl.find_opt state.cmtCache cmt) + with | Some file -> Some file | None -> ( match Shared.tryReadCmt cmt with | None -> None | Some infos -> let file = fileForCmtInfos ~moduleName ~uri infos in - Hashtbl.replace state.cmtCache cmt file; - Some file) + let cached = + SharedTypes.StateSync.with_lock (fun () -> + match Hashtbl.find_opt state.cmtCache cmt with + | Some f -> Some f + | None -> + Hashtbl.replace state.cmtCache cmt file; + Some file) + in + cached) let fileForModule moduleName ~package = match Hashtbl.find_opt package.pathsForModule moduleName with diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 73d43ffc39..6458d2c083 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -551,6 +551,20 @@ let state = cmtCache = Hashtbl.create 30; } +module StateSync = struct + let mutex : Mutex.t = Mutex.create () + + let with_lock f = + Mutex.lock mutex; + match f () with + | v -> + Mutex.unlock mutex; + v + | exception exn -> + Mutex.unlock mutex; + raise exn +end + let locKindToString = function | LocalReference (_, tip) -> "(LocalReference " ^ Tip.toString tip ^ ")" | GlobalReference _ -> "GlobalReference" From efec169e2e2ca036e929936b5033da1cc6c63b79 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 13:55:17 +0200 Subject: [PATCH 03/18] refactor --- analysis/src/References.ml | 52 ++++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 22 deletions(-) diff --git a/analysis/src/References.ml b/analysis/src/References.ml index c79d1952b4..9b1d053b6d 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -436,29 +436,37 @@ type references = { (* Single helper for parallel work distribution over a list. *) let parallel_map ~domain_mgr ~items ~f = let len = List.length items in - let doms = Domain.recommended_domain_count () in - let chunk_size = max 1 (if doms <= 1 then len else (len + doms - 1) / doms) in - let rec chunks_of size lst = - if size <= 0 then [lst] + (* For very small inputs, avoid domain overhead entirely. *) + let small_threshold = 10 in + if len = 0 then [] + else + let doms = Domain.recommended_domain_count () in + (* If there's no parallel capacity or the list is small, run sequentially. *) + if doms <= 1 || len < small_threshold then f items else - match lst with - | [] -> [] - | _ -> - let rec take n acc rest = - if n = 0 then (List.rev acc, rest) - else - match rest with - | [] -> (List.rev acc, []) - | x :: xs -> take (n - 1) (x :: acc) xs - in - let chunk, rest = take size [] lst in - chunk :: chunks_of size rest - in - let chunks = chunks_of chunk_size items in - Eio.Fiber.List.map - (fun chunk -> Eio.Domain_manager.run domain_mgr (fun () -> f chunk)) - chunks - |> List.concat + let chunk_count = min doms len in + let chunk_size = max 1 ((len + chunk_count - 1) / chunk_count) in + let rec chunks_of size lst = + if size <= 0 then [] + else + match lst with + | [] -> [] + | _ -> + let rec take n acc rest = + if n = 0 then (List.rev acc, rest) + else + match rest with + | [] -> (List.rev acc, []) + | x :: xs -> take (n - 1) (x :: acc) xs + in + let chunk, rest = take size [] lst in + chunk :: chunks_of size rest + in + let chunks = chunks_of chunk_size items in + Eio.Fiber.List.map + (fun chunk -> Eio.Domain_manager.run domain_mgr (fun () -> f chunk)) + chunks + |> List.concat let forLocalStamp ~domain_mgr ~full:{file; extra; package} stamp (tip : Tip.t) = let env = QueryEnv.fromFile file in From ea3636fa22c026f31100957a64ae4f4a5aede0e0 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 14:39:34 +0200 Subject: [PATCH 04/18] add eio to dune --- analysis.opam | 3 ++- dune-project | 5 +++-- tools.opam | 2 +- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/analysis.opam b/analysis.opam index 228193d753..73c0ef82a9 100644 --- a/analysis.opam +++ b/analysis.opam @@ -7,8 +7,9 @@ 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.3"} "cppo" {= "1.8.0"} + "eio" "dune" {>= "3.17"} "odoc" {with-doc} ] diff --git a/dune-project b/dune-project index d8e0553c80..a5d40ec0b7 100644 --- a/dune-project +++ b/dune-project @@ -23,9 +23,10 @@ (synopsis "ReScript Analysis") (depends (ocaml - (>= 4.14)) + (>= 5.3)) (cppo (= 1.8.0)) + eio dune)) (package @@ -33,7 +34,7 @@ (synopsis "ReScript Tools") (depends (ocaml - (>= 4.14)) + (>= 5.3)) (cmarkit (>= 0.3.0)) (cppo diff --git a/tools.opam b/tools.opam index 4e31f92595..b8dc2ba522 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.3"} "cmarkit" {>= "0.3.0"} "cppo" {= "1.8.0"} "analysis" From 4fc600e994e7f964b9eeca539f7298ff05bc4065 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 20:14:59 +0200 Subject: [PATCH 05/18] move required OCaml version to 5.3 --- .github/workflows/ci.yml | 6 ------ dune-project | 3 ++- rescript.opam | 2 +- rescript.opam.template | 2 +- scripts/copyExes.js | 5 +++++ 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ce481a6c2f..a02fef82e8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -58,12 +58,6 @@ jobs: node-target: win32-x64 rust-target: x86_64-pc-windows-gnu - # 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 - node-target: linux-x64 - rust-target: x86_64-unknown-linux-musl - runs-on: ${{matrix.os}} env: diff --git a/dune-project b/dune-project index a5d40ec0b7..a34c5c03e9 100644 --- a/dune-project +++ b/dune-project @@ -16,7 +16,8 @@ (package (name rescript) - (synopsis "ReScript compiler")) + (synopsis "ReScript compiler") + (depends (ocaml (>= 5.3)))) (package (name analysis) diff --git a/rescript.opam b/rescript.opam index efb475eb5f..1bcf654ac4 100644 --- a/rescript.opam +++ b/rescript.opam @@ -21,7 +21,7 @@ build: [ ] ] depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.3"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/rescript.opam.template b/rescript.opam.template index ffc4578a2d..45ac68e0ea 100644 --- a/rescript.opam.template +++ b/rescript.opam.template @@ -1,5 +1,5 @@ depends: [ - "ocaml" {>= "4.14"} + "ocaml" {>= "5.3"} "cppo" {= "1.8.0"} "dune" {>= "3.17"} "flow_parser" {= "0.267.0"} diff --git a/scripts/copyExes.js b/scripts/copyExes.js index 7e5ea182a2..8a5c1ef69e 100755 --- a/scripts/copyExes.js +++ b/scripts/copyExes.js @@ -59,6 +59,11 @@ function copyExe(dir, exe, renamed) { const src = path.join(dir, exe + ext); const dest = path.join(binDir, `${renamed ?? exe}.exe`); + // Skip if the source binary was not built (e.g., skipped in a profile). + if (!fs.existsSync(src)) { + return; + } + // For some reason, the copy operation fails in Windows CI if the file already exists. if (process.platform === "win32" && fs.existsSync(dest)) { fs.rmSync(dest); From 63ceb383467f51e90a5c5482bb082e20f1c820fa Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 4 Sep 2025 20:30:11 +0200 Subject: [PATCH 06/18] add dep --- analysis/bin/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/analysis/bin/dune b/analysis/bin/dune index 9f9f943bfa..c0c839a047 100644 --- a/analysis/bin/dune +++ b/analysis/bin/dune @@ -8,4 +8,4 @@ (package analysis) (modes byte exe) (name main) - (libraries analysis eio_main)) + (libraries analysis eio eio_main)) From 2357c2e55ba1702cd9715ee24ccc337a7bb67b47 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 07:43:02 +0200 Subject: [PATCH 07/18] attempt to fix Eio setup --- analysis.opam | 1 + analysis/bin/main.ml | 16 +++++++++------- analysis/src/Commands.ml | 33 ++++++++++++++++----------------- analysis/src/dune | 2 +- dune-project | 5 ++++- 5 files changed, 31 insertions(+), 26 deletions(-) diff --git a/analysis.opam b/analysis.opam index 73c0ef82a9..9299cab202 100644 --- a/analysis.opam +++ b/analysis.opam @@ -10,6 +10,7 @@ depends: [ "ocaml" {>= "5.3"} "cppo" {= "1.8.0"} "eio" + "eio_main" "dune" {>= "3.17"} "odoc" {with-doc} ] diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index f25cb78115..533e7a87b1 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -194,13 +194,15 @@ let main () = Sys.argv.(len - 1) <- ""; Reanalyze.cli () | [_; "references"; path; line; col] -> - Commands.references ~path - ~pos:(int_of_string line, int_of_string col) - ~debug + Eio_main.run (fun env -> + Commands.references ~env ~path + ~pos:(int_of_string line, int_of_string col) + ~debug) | [_; "rename"; path; line; col; newName] -> - Commands.rename ~path - ~pos:(int_of_string line, int_of_string col) - ~newName ~debug + Eio_main.run (fun env -> + Commands.rename ~env ~path + ~pos:(int_of_string line, int_of_string col) + ~newName ~debug) | [_; "semanticTokens"; currentFile] -> SemanticTokens.semanticTokens ~currentFile | [_; "createInterface"; path; cmiFile] -> @@ -208,7 +210,7 @@ let main () = (Json.escape (CreateInterface.command ~path ~cmiFile)) | [_; "format"; path] -> Printf.printf "\"%s\"" (Json.escape (Commands.format ~path)) - | [_; "test"; path] -> Commands.test ~path + | [_; "test"; path] -> Eio_main.run (fun env -> Commands.test ~env ~path) | [_; "cmt"; rescript_json; cmt_path] -> CmtViewer.dump rescript_json cmt_path | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help | _ -> diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 6a0185657a..2ddb2d61eb 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -178,19 +178,18 @@ let typeDefinition ~path ~pos ~debug = | Some location -> location |> Protocol.stringifyLocation) (* Shared helper: collect references in parallel using Eio, like 'references'. *) -let collect_all_references_parallel ~path ~pos ~debug = - Eio_main.run (fun env -> - match Cmt.loadFullCmtFromPath ~path with - | None -> [] - | Some full -> ( - match References.getLocItem ~full ~pos ~debug with - | None -> [] - | Some locItem -> - References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full - locItem)) +let collect_all_references_parallel ~env ~path ~pos ~debug = + match Cmt.loadFullCmtFromPath ~path with + | None -> [] + | Some full -> ( + match References.getLocItem ~full ~pos ~debug with + | None -> [] + | Some locItem -> + References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full + locItem) -let references ~path ~pos ~debug = - let allRefs = collect_all_references_parallel ~path ~pos ~debug in +let references ~env ~path ~pos ~debug = + let allRefs = collect_all_references_parallel ~env ~path ~pos ~debug in let allLocs = allRefs |> List.fold_left @@ -209,8 +208,8 @@ let references ~path ~pos ~debug = (if allLocs = [] then Protocol.null else "[\n" ^ (allLocs |> String.concat ",\n") ^ "\n]") -let rename ~path ~pos ~newName ~debug = - let allReferences = collect_all_references_parallel ~path ~pos ~debug in +let rename ~env ~path ~pos ~newName ~debug = + let allReferences = collect_all_references_parallel ~env ~path ~pos ~debug in let referencesToToplevelModules = allReferences |> Utils.filterMap (fun {References.uri = uri2; locOpt} -> @@ -289,7 +288,7 @@ let format ~path = let diagnosticSyntax ~path = print_endline (Diagnostics.document_syntax ~path |> Protocol.array) -let test ~path = +let test ~env ~path = Uri.stripPath := true; match Files.readFile path with | None -> assert false @@ -409,7 +408,7 @@ let test ~path = print_endline ("References " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col); - references ~path ~pos:(line, col) ~debug:true + references ~env ~path ~pos:(line, col) ~debug:true | "ren" -> let newName = String.sub rest 4 (len - mlen - 4) in let () = @@ -417,7 +416,7 @@ let test ~path = ("Rename " ^ path ^ " " ^ string_of_int line ^ ":" ^ string_of_int col ^ " " ^ newName) in - rename ~path ~pos:(line, col) ~newName ~debug:true + rename ~env ~path ~pos:(line, col) ~newName ~debug:true | "typ" -> print_endline ("TypeDefinition " ^ path ^ " " ^ string_of_int line ^ ":" diff --git a/analysis/src/dune b/analysis/src/dune index 5243f37b4c..0d45fdea20 100644 --- a/analysis/src/dune +++ b/analysis/src/dune @@ -2,4 +2,4 @@ (name analysis) (flags (-w "+6+26+27+32+33+39")) - (libraries unix str ext ml jsonlib syntax reanalyze eio eio_main)) + (libraries unix str ext ml jsonlib syntax reanalyze eio)) diff --git a/dune-project b/dune-project index a34c5c03e9..fe07265334 100644 --- a/dune-project +++ b/dune-project @@ -17,7 +17,9 @@ (package (name rescript) (synopsis "ReScript compiler") - (depends (ocaml (>= 5.3)))) + (depends + (ocaml + (>= 5.3)))) (package (name analysis) @@ -28,6 +30,7 @@ (cppo (= 1.8.0)) eio + eio_main dune)) (package From 58d1393e66b9297b4d09bf0f3d85f6f3e8f4ea1e Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 09:14:43 +0200 Subject: [PATCH 08/18] try to fix CI --- .github/workflows/ci.yml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index a02fef82e8..d45fd122ab 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -96,7 +96,7 @@ jobs: uses: awalsh128/cache-apt-pkgs-action@v1.4.3 with: # See https://github.com/ocaml/setup-ocaml/blob/b2105f9/packages/setup-ocaml/src/unix.ts#L9 - packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync + packages: bubblewrap darcs g++-multilib gcc-multilib mercurial musl-tools rsync linux-libc-dev dpkg-dev version: v3 - name: Restore rewatch build cache @@ -256,7 +256,12 @@ jobs: - name: Build compiler (Linux static) if: runner.os == 'Linux' - run: opam exec -- dune build --display quiet --profile static + run: | + # ocaml-option-static sets CC=musl-gcc. On Ubuntu multiarch, Linux UAPI headers + # live under /usr/include/$(dpkg-architecture -qDEB_HOST_MULTIARCH), which musl-gcc + # doesn't search by default. Inject that include dir only for this build via CC. + arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) + CC="musl-gcc -idirafter /usr/include/$arch" opam exec -- dune build --display quiet --profile static - name: Delete stable compiler build state if: github.event_name == 'push' && github.ref == 'refs/heads/master' From 966836b2b9eeb63d5ba7b42105b76c3637a6b45b Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 10:04:50 +0200 Subject: [PATCH 09/18] ci --- .github/workflows/ci.yml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d45fd122ab..2789f6b36c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -175,7 +175,13 @@ jobs: - name: Install OPAM dependencies if: steps.cache-opam-env.outputs.cache-hit != 'true' - run: opam install . --deps-only --with-test + run: | + if [ "$RUNNER_OS" = "Linux" ]; then + arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) + C_INCLUDE_PATH="/usr/include/$arch" opam install . --deps-only --with-test + else + opam install . --deps-only --with-test + fi - name: Cache OPAM environment if: steps.cache-opam-env.outputs.cache-hit != 'true' @@ -257,11 +263,8 @@ jobs: - name: Build compiler (Linux static) if: runner.os == 'Linux' run: | - # ocaml-option-static sets CC=musl-gcc. On Ubuntu multiarch, Linux UAPI headers - # live under /usr/include/$(dpkg-architecture -qDEB_HOST_MULTIARCH), which musl-gcc - # doesn't search by default. Inject that include dir only for this build via CC. arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) - CC="musl-gcc -idirafter /usr/include/$arch" opam exec -- dune build --display quiet --profile static + C_INCLUDE_PATH="/usr/include/$arch" opam exec -- dune build --display quiet --profile static - name: Delete stable compiler build state if: github.event_name == 'push' && github.ref == 'refs/heads/master' From b956b145476bb5fcd620ba3ce396dbe2b4809cbc Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 10:27:01 +0200 Subject: [PATCH 10/18] ci --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 2789f6b36c..368dadd40c 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -178,7 +178,7 @@ jobs: run: | if [ "$RUNNER_OS" = "Linux" ]; then arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) - C_INCLUDE_PATH="/usr/include/$arch" opam install . --deps-only --with-test + C_INCLUDE_PATH="/usr/include:/usr/include/$arch" CPATH="/usr/include:/usr/include/$arch" opam install . --deps-only --with-test else opam install . --deps-only --with-test fi @@ -264,7 +264,7 @@ jobs: if: runner.os == 'Linux' run: | arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) - C_INCLUDE_PATH="/usr/include/$arch" opam exec -- dune build --display quiet --profile static + C_INCLUDE_PATH="/usr/include:/usr/include/$arch" CPATH="/usr/include:/usr/include/$arch" opam exec -- dune build --display quiet --profile static - name: Delete stable compiler build state if: github.event_name == 'push' && github.ref == 'refs/heads/master' From 0663fc5e52f4aeb250494afb48dee81c6060744a Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 11:07:47 +0200 Subject: [PATCH 11/18] try removing explicit eio_main dep --- analysis.opam | 1 - dune-project | 1 - scripts/copyExes.js | 5 ----- 3 files changed, 7 deletions(-) diff --git a/analysis.opam b/analysis.opam index 9299cab202..73c0ef82a9 100644 --- a/analysis.opam +++ b/analysis.opam @@ -10,7 +10,6 @@ depends: [ "ocaml" {>= "5.3"} "cppo" {= "1.8.0"} "eio" - "eio_main" "dune" {>= "3.17"} "odoc" {with-doc} ] diff --git a/dune-project b/dune-project index fe07265334..38b9dd46c2 100644 --- a/dune-project +++ b/dune-project @@ -30,7 +30,6 @@ (cppo (= 1.8.0)) eio - eio_main dune)) (package diff --git a/scripts/copyExes.js b/scripts/copyExes.js index 8a5c1ef69e..7e5ea182a2 100755 --- a/scripts/copyExes.js +++ b/scripts/copyExes.js @@ -59,11 +59,6 @@ function copyExe(dir, exe, renamed) { const src = path.join(dir, exe + ext); const dest = path.join(binDir, `${renamed ?? exe}.exe`); - // Skip if the source binary was not built (e.g., skipped in a profile). - if (!fs.existsSync(src)) { - return; - } - // For some reason, the copy operation fails in Windows CI if the file already exists. if (process.platform === "win32" && fs.existsSync(dest)) { fs.rmSync(dest); From b265377078fa9f891cb4963c36bc3bcdf8ee6558 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 11:14:28 +0200 Subject: [PATCH 12/18] revert removing eio_main, and try removing depends 5.3 from the compiler itself --- analysis.opam | 1 + dune-project | 6 ++---- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/analysis.opam b/analysis.opam index 73c0ef82a9..9299cab202 100644 --- a/analysis.opam +++ b/analysis.opam @@ -10,6 +10,7 @@ depends: [ "ocaml" {>= "5.3"} "cppo" {= "1.8.0"} "eio" + "eio_main" "dune" {>= "3.17"} "odoc" {with-doc} ] diff --git a/dune-project b/dune-project index 38b9dd46c2..4189bbc436 100644 --- a/dune-project +++ b/dune-project @@ -16,10 +16,7 @@ (package (name rescript) - (synopsis "ReScript compiler") - (depends - (ocaml - (>= 5.3)))) + (synopsis "ReScript compiler")) (package (name analysis) @@ -30,6 +27,7 @@ (cppo (= 1.8.0)) eio + eio_main dune)) (package From 1c1e29937cea3dd79cf33bbb53dba738be7a18d7 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 12:19:02 +0200 Subject: [PATCH 13/18] tweak --- .github/workflows/ci.yml | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 368dadd40c..eb8cd89a67 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -173,15 +173,17 @@ jobs: await fs.writeFile('.opam-path', opamPath, 'utf-8'); console.log('stored path to .opam-path'); + - name: Configure Linux include paths + if: runner.os == 'Linux' + run: | + arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) + echo "C_INCLUDE_PATH=/usr/include:/usr/include/$arch" >> "$GITHUB_ENV" + echo "CPATH=/usr/include:/usr/include/$arch" >> "$GITHUB_ENV" + - name: Install OPAM dependencies if: steps.cache-opam-env.outputs.cache-hit != 'true' run: | - if [ "$RUNNER_OS" = "Linux" ]; then - arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) - C_INCLUDE_PATH="/usr/include:/usr/include/$arch" CPATH="/usr/include:/usr/include/$arch" opam install . --deps-only --with-test - else - opam install . --deps-only --with-test - fi + opam install . --deps-only --with-test - name: Cache OPAM environment if: steps.cache-opam-env.outputs.cache-hit != 'true' @@ -262,9 +264,7 @@ jobs: - name: Build compiler (Linux static) if: runner.os == 'Linux' - run: | - arch=$(dpkg-architecture -qDEB_HOST_MULTIARCH) - C_INCLUDE_PATH="/usr/include:/usr/include/$arch" CPATH="/usr/include:/usr/include/$arch" opam exec -- dune build --display quiet --profile static + run: opam exec -- dune build --display quiet --profile static - name: Delete stable compiler build state if: github.event_name == 'push' && github.ref == 'refs/heads/master' From 97f9e2b625a6aee80901e8eea85ea9339cb232c0 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 12:30:43 +0200 Subject: [PATCH 14/18] unecessary change --- .github/workflows/ci.yml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index eb8cd89a67..58d1932ca2 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -182,8 +182,7 @@ jobs: - name: Install OPAM dependencies if: steps.cache-opam-env.outputs.cache-hit != 'true' - run: | - opam install . --deps-only --with-test + run: opam install . --deps-only --with-test - name: Cache OPAM environment if: steps.cache-opam-env.outputs.cache-hit != 'true' From 4d74fcc25a552dafd9e73745e748ba131826782a Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 5 Sep 2025 12:31:45 +0200 Subject: [PATCH 15/18] changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2a3de8b852..4ba3ebd1f1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -23,6 +23,7 @@ - Add support for ArrayBuffer and typed arrays to `@unboxed`. https://github.com/rescript-lang/rescript/pull/7788 - Experimental: Add `let?` syntax for unwrapping and propagating errors/none as early returns for option/result types. https://github.com/rescript-lang/rescript/pull/7582 - Add support for shipping features as experimental, including configuring what experimental features are enabled in `rescript.json`. https://github.com/rescript-lang/rescript/pull/7582 +- Use multicore OCaml with Eio to speed up the `rename` and `find all references` commands. https://github.com/rescript-lang/rescript/pull/7840 #### :bug: Bug fix From 43527087e9794e76b0a85a607ea61ed10bb68173 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sat, 6 Sep 2025 14:18:27 +0200 Subject: [PATCH 16/18] get rid of global locks in favor of domain local caches --- analysis/bin/main.ml | 2 +- analysis/src/AnalysisCache.ml | 7 +++ analysis/src/Cmt.ml | 82 +++++++++++++++++++++++------------ analysis/src/Packages.ml | 55 +++++++++++++---------- analysis/src/ProcessCmt.ml | 19 ++------ analysis/src/References.ml | 8 ++-- analysis/src/SharedTypes.ml | 31 +++---------- 7 files changed, 109 insertions(+), 95 deletions(-) create mode 100644 analysis/src/AnalysisCache.ml diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index 533e7a87b1..d51db203fe 100644 --- a/analysis/bin/main.ml +++ b/analysis/bin/main.ml @@ -119,7 +119,7 @@ let main () = | [_; "cache-delete"; rootPath] -> ( Cfg.readProjectConfigCache := false; let uri = Uri.fromPath rootPath in - match Packages.findRoot ~uri (Hashtbl.create 0) with + match Packages.findRoot ~uri with | Some (`Bs rootPath) -> ( match BuildSystem.getLibBs rootPath with | None -> print_endline "\"ERR\"" diff --git a/analysis/src/AnalysisCache.ml b/analysis/src/AnalysisCache.ml new file mode 100644 index 0000000000..cacc838795 --- /dev/null +++ b/analysis/src/AnalysisCache.ml @@ -0,0 +1,7 @@ +(* Helpers for domain-local caches *) + +let make_hashtbl (size : int) : ('k, 'v) Hashtbl.t Domain.DLS.key = + Domain.DLS.new_key (fun () -> Hashtbl.create size) + +let get_hashtbl (key : ('k, 'v) Hashtbl.t Domain.DLS.key) : ('k, 'v) Hashtbl.t = + Domain.DLS.get key diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index a433d12908..be4dbdaa45 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -1,5 +1,12 @@ open SharedTypes +module FullCache = struct + let key : (string, full) Hashtbl.t Domain.DLS.key = + AnalysisCache.make_hashtbl 64 + + let get () : (string, full) Hashtbl.t = AnalysisCache.get_hashtbl key +end + let fullForCmt ~moduleName ~package ~uri cmt = match Shared.tryReadCmt cmt with | None -> None @@ -8,45 +15,64 @@ let fullForCmt ~moduleName ~package ~uri cmt = let extra = ProcessExtra.getExtra ~file ~infos in Some {file; extra; package} -let fullFromUri ~uri = +let fullFromUriWithPackage ~package ~uri = let path = Uri.toPath uri in - match Packages.getPackage ~uri with - | None -> None - | Some package -> ( - let moduleName = - BuildSystem.namespacedName package.namespace (FindFiles.getName path) - in - let incremental = - if !Cfg.inIncrementalTypecheckingMode then - let incrementalCmtPath = - package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName - ^ - match Files.classifySourceFile path with - | Resi -> ".cmti" - | _ -> ".cmt" - in - fullForCmt ~moduleName ~package ~uri incrementalCmtPath - else None + let moduleName = + BuildSystem.namespacedName package.namespace (FindFiles.getName path) + in + let cached_full cmt_path = + let cache = FullCache.get () in + match Hashtbl.find_opt cache cmt_path with + | Some v -> Some v + | None -> ( + match fullForCmt ~moduleName ~package ~uri cmt_path with + | Some v as res -> + Hashtbl.replace cache cmt_path v; + res + | None -> None) + in + if !Cfg.inIncrementalTypecheckingMode then + let incrementalCmtPath = + package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName + ^ + match Files.classifySourceFile path with + | Resi -> ".cmti" + | _ -> ".cmt" in - match incremental with - | Some cmtInfo -> - if Debug.verbose () then Printf.printf "[cmt] Found incremental cmt\n"; - Some cmtInfo + match cached_full incrementalCmtPath with + | Some _ as x -> x | None -> ( + (* Fallback to non-incremental *) match Hashtbl.find_opt package.pathsForModule moduleName with | Some paths -> let cmt = getCmtPath ~uri paths in - fullForCmt ~moduleName ~package ~uri cmt + cached_full cmt | None -> prerr_endline ("can't find module " ^ moduleName); - None)) + None) + else + match Hashtbl.find_opt package.pathsForModule moduleName with + | Some paths -> + let cmt = getCmtPath ~uri paths in + cached_full cmt + | None -> + prerr_endline ("can't find module " ^ moduleName); + None + +let fullFromUri ~uri = + match Packages.getPackage ~uri with + | None -> None + | Some package -> fullFromUriWithPackage ~package ~uri let fullsFromModule ~package ~moduleName = - if Hashtbl.mem package.pathsForModule moduleName then - let paths = Hashtbl.find package.pathsForModule moduleName in + match Hashtbl.find_opt package.pathsForModule moduleName with + | None -> [] + | Some paths -> let uris = getUris paths in - uris |> List.filter_map (fun uri -> fullFromUri ~uri) - else [] + uris + |> List.filter_map (fun uri -> + let cmt = getCmtPath ~uri paths in + fullForCmt ~moduleName ~package ~uri cmt) let loadFullCmtFromPath ~path = let uri = Uri.fromPath path in diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index 918bb49845..efbd18441d 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,5 +1,17 @@ open SharedTypes +(* Domain-local caches for packages and URI->root mapping. *) +module LocalCache = struct + let packages_key : (string, package) Hashtbl.t Domain.DLS.key = + AnalysisCache.make_hashtbl 1 + + let roots_key : (Uri.t, string) Hashtbl.t Domain.DLS.key = + AnalysisCache.make_hashtbl 30 + + let packages () = AnalysisCache.get_hashtbl packages_key + let roots () = AnalysisCache.get_hashtbl roots_key +end + (* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *) let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths = let pathsForModule = Hashtbl.create 30 in @@ -200,14 +212,11 @@ let newBsPackage ~rootPath = Log.log ("Unable to read " ^ bsconfigJson); None) -let findRoot ~uri packagesByRoot = +let findRoot ~uri = let path = Uri.toPath uri in let rec loop path = if path = "/" then None - else if - SharedTypes.StateSync.with_lock (fun () -> - Hashtbl.mem packagesByRoot path) - then Some (`Root path) + else if Hashtbl.mem (LocalCache.packages ()) path then Some (`Root path) else if Files.exists (Filename.concat path "rescript.json") || Files.exists (Filename.concat path "bsconfig.json") @@ -219,29 +228,29 @@ let findRoot ~uri packagesByRoot = loop (if Sys.is_directory path then path else Filename.dirname path) let getPackage ~uri = - let open SharedTypes in - match - SharedTypes.StateSync.with_lock (fun () -> - if Hashtbl.mem state.rootForUri uri then - let root = Hashtbl.find state.rootForUri uri in - Some (Hashtbl.find state.packagesByRoot root) - else None) - with - | Some pkg -> Some pkg + let roots = LocalCache.roots () in + let packages = LocalCache.packages () in + match Hashtbl.find_opt roots uri with + | Some root -> Hashtbl.find_opt packages root | None -> ( - match findRoot ~uri state.packagesByRoot with + match findRoot ~uri with | None -> Log.log "No root directory found"; None - | Some (`Root rootPath) -> - SharedTypes.StateSync.with_lock (fun () -> - Hashtbl.replace state.rootForUri uri rootPath; - Some (Hashtbl.find state.packagesByRoot rootPath)) + | Some (`Root rootPath) -> ( + Hashtbl.replace roots uri rootPath; + match Hashtbl.find_opt packages rootPath with + | Some pkg -> Some pkg + | None -> ( + match newBsPackage ~rootPath with + | Some pkg -> + Hashtbl.replace packages rootPath pkg; + Some pkg + | None -> None)) | Some (`Bs rootPath) -> ( match newBsPackage ~rootPath with | None -> None | Some package -> - SharedTypes.StateSync.with_lock (fun () -> - Hashtbl.replace state.rootForUri uri package.rootPath; - Hashtbl.replace state.packagesByRoot package.rootPath package; - Some package))) + Hashtbl.replace roots uri package.rootPath; + Hashtbl.replace packages package.rootPath package; + Some package)) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index cd42705d9a..01ee40f33d 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -773,27 +773,16 @@ let fileForCmtInfos ~moduleName ~uri | _ -> File.create moduleName uri let fileForCmt ~moduleName ~cmt ~uri = - (* Double-checked locking: fast path under lock; if missing, compute without - holding the lock, then insert under lock if still absent. *) - match - SharedTypes.StateSync.with_lock (fun () -> - Hashtbl.find_opt state.cmtCache cmt) - with + let local = SharedTypes.CmtCache.get () in + match Hashtbl.find_opt local cmt with | Some file -> Some file | None -> ( match Shared.tryReadCmt cmt with | None -> None | Some infos -> let file = fileForCmtInfos ~moduleName ~uri infos in - let cached = - SharedTypes.StateSync.with_lock (fun () -> - match Hashtbl.find_opt state.cmtCache cmt with - | Some f -> Some f - | None -> - Hashtbl.replace state.cmtCache cmt file; - Some file) - in - cached) + Hashtbl.replace local cmt file; + Some file) let fileForModule moduleName ~package = match Hashtbl.find_opt package.pathsForModule moduleName with diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 9b1d053b6d..370e730c53 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -219,7 +219,9 @@ let alternateDeclared ~(file : File.t) ~package (declared : _ Declared.t) tip = maybeLog ("alternateDeclared for " ^ file.moduleName ^ " has both resi and res"); let alternateUri = if Uri.isInterface file.uri then res else resi in - match Cmt.fullFromUri ~uri:(Uri.fromPath alternateUri) with + match + Cmt.fullFromUriWithPackage ~package ~uri:(Uri.fromPath alternateUri) + with | None -> None | Some {file; extra} -> ( let env = QueryEnv.fromFile file in @@ -568,7 +570,7 @@ let allReferencesForLocItem ~domain_mgr ~full:({file; package} as full) locItem match ProcessCmt.fileForModule ~package name with | None -> [] | Some file -> ( - match Cmt.fullFromUri ~uri:file.uri with + match Cmt.fullFromUriWithPackage ~package ~uri:file.uri with | None -> [] | Some full -> ( match @@ -612,7 +614,7 @@ let allReferencesForLocItem ~domain_mgr ~full:({file; package} as full) locItem match exportedForTip ~env ~path ~package ~tip with | None -> [] | Some (env, _name, stamp) -> ( - match Cmt.fullFromUri ~uri:env.file.uri with + match Cmt.fullFromUriWithPackage ~package ~uri:env.file.uri with | None -> [] | Some full -> maybeLog diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 6458d2c083..f658d138d9 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -537,34 +537,15 @@ let initExtra () = locItems = []; } -type state = { - packagesByRoot: (string, package) Hashtbl.t; - rootForUri: (Uri.t, string) Hashtbl.t; - cmtCache: (filePath, File.t) Hashtbl.t; -} +module CmtCache = struct + let key : (filePath, File.t) Hashtbl.t Domain.DLS.key = + AnalysisCache.make_hashtbl 30 -(* There's only one state, so it can as well be global *) -let state = - { - packagesByRoot = Hashtbl.create 1; - rootForUri = Hashtbl.create 30; - cmtCache = Hashtbl.create 30; - } - -module StateSync = struct - let mutex : Mutex.t = Mutex.create () - - let with_lock f = - Mutex.lock mutex; - match f () with - | v -> - Mutex.unlock mutex; - v - | exception exn -> - Mutex.unlock mutex; - raise exn + let get () : (filePath, File.t) Hashtbl.t = AnalysisCache.get_hashtbl key end +module StringMap = Map.Make (String) + let locKindToString = function | LocalReference (_, tip) -> "(LocalReference " ^ Tip.toString tip ^ ")" | GlobalReference _ -> "GlobalReference" From 8d9d7f0dc297968f927bd84ab46c8f8e1597e354 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Mon, 8 Sep 2025 09:04:07 +0200 Subject: [PATCH 17/18] cleanup --- analysis/src/Cmt.ml | 4 ++-- analysis/src/EioUtils.ml | 35 ++++++++++++++++++++++++++++++++++ analysis/src/Packages.ml | 3 ++- analysis/src/References.ml | 39 ++------------------------------------ 4 files changed, 41 insertions(+), 40 deletions(-) create mode 100644 analysis/src/EioUtils.ml diff --git a/analysis/src/Cmt.ml b/analysis/src/Cmt.ml index be4dbdaa45..1c5b19cfe1 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -1,5 +1,6 @@ open SharedTypes +(* Caches for the `full` type *) module FullCache = struct let key : (string, full) Hashtbl.t Domain.DLS.key = AnalysisCache.make_hashtbl 64 @@ -40,9 +41,8 @@ let fullFromUriWithPackage ~package ~uri = | _ -> ".cmt" in match cached_full incrementalCmtPath with - | Some _ as x -> x + | Some x -> Some x | None -> ( - (* Fallback to non-incremental *) match Hashtbl.find_opt package.pathsForModule moduleName with | Some paths -> let cmt = getCmtPath ~uri paths in diff --git a/analysis/src/EioUtils.ml b/analysis/src/EioUtils.ml new file mode 100644 index 0000000000..30d8b8b01e --- /dev/null +++ b/analysis/src/EioUtils.ml @@ -0,0 +1,35 @@ +(* For very small inputs, avoid domain overhead entirely. *) +let small_threshold = 10 + +(* Helper for parallel work distribution over a list. *) +let parallel_map ~domain_mgr ~items ~f = + let len = List.length items in + if len = 0 then [] + else + let doms = Domain.recommended_domain_count () in + (* If there's no parallel capacity or the list is small, run sequentially. *) + if doms <= 1 || len < small_threshold then f items + else + let chunk_count = min doms len in + let chunk_size = max 1 ((len + chunk_count - 1) / chunk_count) in + let rec chunks_of size lst = + if size <= 0 then [] + else + match lst with + | [] -> [] + | _ -> + let rec take n acc rest = + if n = 0 then (List.rev acc, rest) + else + match rest with + | [] -> (List.rev acc, []) + | x :: xs -> take (n - 1) (x :: acc) xs + in + let chunk, rest = take size [] lst in + chunk :: chunks_of size rest + in + let chunks = chunks_of chunk_size items in + Eio.Fiber.List.map + (fun chunk -> Eio.Domain_manager.run domain_mgr (fun () -> f chunk)) + chunks + |> List.concat diff --git a/analysis/src/Packages.ml b/analysis/src/Packages.ml index efbd18441d..d643e9f5a6 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,6 +1,7 @@ open SharedTypes -(* Domain-local caches for packages and URI->root mapping. *) +(* Domain-local caches for packages and URI->root mapping. +These work in both Eio contexts and outside, so they should be safe to use as-is. *) module LocalCache = struct let packages_key : (string, package) Hashtbl.t Domain.DLS.key = AnalysisCache.make_hashtbl 1 diff --git a/analysis/src/References.ml b/analysis/src/References.ml index 370e730c53..74ee7b0b36 100644 --- a/analysis/src/References.ml +++ b/analysis/src/References.ml @@ -435,41 +435,6 @@ type references = { locOpt: Location.t option; (* None: reference to a toplevel module *) } -(* Single helper for parallel work distribution over a list. *) -let parallel_map ~domain_mgr ~items ~f = - let len = List.length items in - (* For very small inputs, avoid domain overhead entirely. *) - let small_threshold = 10 in - if len = 0 then [] - else - let doms = Domain.recommended_domain_count () in - (* If there's no parallel capacity or the list is small, run sequentially. *) - if doms <= 1 || len < small_threshold then f items - else - let chunk_count = min doms len in - let chunk_size = max 1 ((len + chunk_count - 1) / chunk_count) in - let rec chunks_of size lst = - if size <= 0 then [] - else - match lst with - | [] -> [] - | _ -> - let rec take n acc rest = - if n = 0 then (List.rev acc, rest) - else - match rest with - | [] -> (List.rev acc, []) - | x :: xs -> take (n - 1) (x :: acc) xs - in - let chunk, rest = take size [] lst in - chunk :: chunks_of size rest - in - let chunks = chunks_of chunk_size items in - Eio.Fiber.List.map - (fun chunk -> Eio.Domain_manager.run domain_mgr (fun () -> f chunk)) - chunks - |> List.concat - let forLocalStamp ~domain_mgr ~full:{file; extra; package} stamp (tip : Tip.t) = let env = QueryEnv.fromFile file in match @@ -527,7 +492,7 @@ let forLocalStamp ~domain_mgr ~full:{file; extra; package} stamp (tip : Tip.t) = |> List.filter (fun name -> name <> file.moduleName) in let results = - parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> + EioUtils.parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> let process_module moduleName = Cmt.fullsFromModule ~package ~moduleName |> List.map (fun {file; extra} -> @@ -565,7 +530,7 @@ let allReferencesForLocItem ~domain_mgr ~full:({file; package} as full) locItem let otherModulesReferences = let names = package.projectFiles |> FileSet.elements in let per_chunk = - parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> + EioUtils.parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> let process_name name = match ProcessCmt.fileForModule ~package name with | None -> [] From a72edaf7bf5e18c6ec706a6dc3f03361fd91c90d Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 12 Sep 2025 12:58:31 +0200 Subject: [PATCH 18/18] domain local cache for typeToString as well --- analysis/src/Shared.ml | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/analysis/src/Shared.ml b/analysis/src/Shared.ml index b2d7edf76e..60dc660e28 100644 --- a/analysis/src/Shared.ml +++ b/analysis/src/Shared.ml @@ -63,9 +63,17 @@ let declToString ?printNameAsIs ?(recStatus = Types.Trec_not) name t = PrintType.printDecl ?printNameAsIs ~recStatus name t let cacheTypeToString = ref false -let typeTbl = Hashtbl.create 1 + +module TypeToStringCache = struct + let key : (int * Types.type_expr, string) Hashtbl.t Domain.DLS.key = + AnalysisCache.make_hashtbl 1 + + let get () : (int * Types.type_expr, string) Hashtbl.t = + AnalysisCache.get_hashtbl key +end let typeToString ?lineWidth (t : Types.type_expr) = + let typeTbl = TypeToStringCache.get () in match if !cacheTypeToString then Hashtbl.find_opt typeTbl (t.id, t) else None with