diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index ce481a6c2f..58d1932ca2 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: @@ -102,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 @@ -179,6 +173,13 @@ 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: opam install . --deps-only --with-test 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 diff --git a/analysis.opam b/analysis.opam index 228193d753..9299cab202 100644 --- a/analysis.opam +++ b/analysis.opam @@ -7,8 +7,10 @@ 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" + "eio_main" "dune" {>= "3.17"} "odoc" {with-doc} ] diff --git a/analysis/bin/dune b/analysis/bin/dune index 64c2a78156..c0c839a047 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 eio_main)) diff --git a/analysis/bin/main.ml b/analysis/bin/main.ml index f25cb78115..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\"" @@ -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/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..1c5b19cfe1 100644 --- a/analysis/src/Cmt.ml +++ b/analysis/src/Cmt.ml @@ -1,5 +1,13 @@ open SharedTypes +(* Caches for the `full` type *) +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 +16,63 @@ 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 x -> Some x | None -> ( 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/Commands.ml b/analysis/src/Commands.ml index a4ac9168f5..2ddb2d61eb 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -177,101 +177,95 @@ let typeDefinition ~path ~pos ~debug = | None -> Protocol.null | Some location -> location |> Protocol.stringifyLocation) -let references ~path ~pos ~debug = - let allLocs = - match Cmt.loadFullCmtFromPath ~path with +(* Shared helper: collect references in parallel using Eio, like 'references'. *) +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 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) - []) + | Some locItem -> + References.allReferencesForLocItem ~domain_mgr:env#domain_mgr ~full + locItem) + +let references ~env ~path ~pos ~debug = + let allRefs = collect_all_references_parallel ~env ~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 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 = - 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 +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} -> + 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 - "[\n" - ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") - ^ "\n]") + textDocumentEdit :: acc) + textEditsByUri [] + in + let fileRenamesString = + fileRenames |> List.map Protocol.stringifyRenameFile + in + let textDocumentEditsString = + textDocumentEdits |> List.map Protocol.stringifyTextDocumentEdit + in + let result = + "[\n" + ^ (fileRenamesString @ textDocumentEditsString |> String.concat ",\n") + ^ "\n]" in print_endline result @@ -294,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 @@ -414,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 () = @@ -422,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/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 bb455d925d..d643e9f5a6 100644 --- a/analysis/src/Packages.ml +++ b/analysis/src/Packages.ml @@ -1,5 +1,18 @@ open SharedTypes +(* 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 + + 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,11 +213,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 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") @@ -216,22 +229,29 @@ let findRoot ~uri packagesByRoot = loop (if Sys.is_directory path then path else Filename.dirname path) 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 findRoot ~uri state.packagesByRoot with + 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 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)) + | 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 -> - 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 96601f6e3b..01ee40f33d 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -773,14 +773,15 @@ let fileForCmtInfos ~moduleName ~uri | _ -> File.create moduleName uri let fileForCmt ~moduleName ~cmt ~uri = - match 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 - Hashtbl.replace state.cmtCache cmt file; + Hashtbl.replace local cmt file; Some file) let fileForModule moduleName ~package = diff --git a/analysis/src/References.ml b/analysis/src/References.ml index e047a2ba18..74ee7b0b36 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) @@ -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 @@ -433,7 +435,7 @@ type references = { locOpt: Location.t option; (* None: reference to a toplevel module *) } -let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) = +let forLocalStamp ~domain_mgr ~full:{file; extra; package} stamp (tip : Tip.t) = let env = QueryEnv.fromFile file in match match tip with @@ -485,30 +487,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 = + EioUtils.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 +523,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 = + EioUtils.parallel_map ~domain_mgr ~items:names ~f:(fun chunk -> + let process_name name = + match ProcessCmt.fileForModule ~package name with + | None -> [] + | Some file -> ( + match Cmt.fullFromUriWithPackage ~package ~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 +563,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 @@ -563,11 +579,11 @@ let allReferencesForLocItem ~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 ("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/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 diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 73d43ffc39..f658d138d9 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -537,19 +537,14 @@ 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; - } + 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 ^ ")" diff --git a/analysis/src/dune b/analysis/src/dune index c1bd828c11..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)) + (libraries unix str ext ml jsonlib syntax reanalyze eio)) diff --git a/dune-project b/dune-project index d8e0553c80..4189bbc436 100644 --- a/dune-project +++ b/dune-project @@ -23,9 +23,11 @@ (synopsis "ReScript Analysis") (depends (ocaml - (>= 4.14)) + (>= 5.3)) (cppo (= 1.8.0)) + eio + eio_main dune)) (package @@ -33,7 +35,7 @@ (synopsis "ReScript Tools") (depends (ocaml - (>= 4.14)) + (>= 5.3)) (cmarkit (>= 0.3.0)) (cppo 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/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"