1
1
open SharedTypes
2
2
3
+ (* Domain-local caches for packages and URI->root mapping. *)
4
+ module LocalCache = struct
5
+ let packages_key : (string, package) Hashtbl.t Domain.DLS.key =
6
+ AnalysisCache. make_hashtbl 1
7
+
8
+ let roots_key : (Uri.t, string) Hashtbl.t Domain.DLS.key =
9
+ AnalysisCache. make_hashtbl 30
10
+
11
+ let packages () = AnalysisCache. get_hashtbl packages_key
12
+ let roots () = AnalysisCache. get_hashtbl roots_key
13
+ end
14
+
3
15
(* Creates the `pathsForModule` hashtbl, which maps a `moduleName` to it's `paths` (the ml/re, mli/rei, cmt, and cmti files) *)
4
16
let makePathsForModule ~projectFilesAndPaths ~dependenciesFilesAndPaths =
5
17
let pathsForModule = Hashtbl. create 30 in
@@ -200,14 +212,11 @@ let newBsPackage ~rootPath =
200
212
Log. log (" Unable to read " ^ bsconfigJson);
201
213
None )
202
214
203
- let findRoot ~uri packagesByRoot =
215
+ let findRoot ~uri =
204
216
let path = Uri. toPath uri in
205
217
let rec loop path =
206
218
if path = " /" then None
207
- else if
208
- SharedTypes.StateSync. with_lock (fun () ->
209
- Hashtbl. mem packagesByRoot path)
210
- then Some (`Root path)
219
+ else if Hashtbl. mem (LocalCache. packages () ) path then Some (`Root path)
211
220
else if
212
221
Files. exists (Filename. concat path " rescript.json" )
213
222
|| Files. exists (Filename. concat path " bsconfig.json" )
@@ -219,29 +228,29 @@ let findRoot ~uri packagesByRoot =
219
228
loop (if Sys. is_directory path then path else Filename. dirname path)
220
229
221
230
let getPackage ~uri =
222
- let open SharedTypes in
223
- match
224
- SharedTypes.StateSync. with_lock (fun () ->
225
- if Hashtbl. mem state.rootForUri uri then
226
- let root = Hashtbl. find state.rootForUri uri in
227
- Some (Hashtbl. find state.packagesByRoot root)
228
- else None )
229
- with
230
- | Some pkg -> Some pkg
231
+ let roots = LocalCache. roots () in
232
+ let packages = LocalCache. packages () in
233
+ match Hashtbl. find_opt roots uri with
234
+ | Some root -> Hashtbl. find_opt packages root
231
235
| None -> (
232
- match findRoot ~uri state.packagesByRoot with
236
+ match findRoot ~uri with
233
237
| None ->
234
238
Log. log " No root directory found" ;
235
239
None
236
- | Some (`Root rootPath ) ->
237
- SharedTypes.StateSync. with_lock (fun () ->
238
- Hashtbl. replace state.rootForUri uri rootPath;
239
- Some (Hashtbl. find state.packagesByRoot rootPath))
240
+ | Some (`Root rootPath ) -> (
241
+ Hashtbl. replace roots uri rootPath;
242
+ match Hashtbl. find_opt packages rootPath with
243
+ | Some pkg -> Some pkg
244
+ | None -> (
245
+ match newBsPackage ~root Path with
246
+ | Some pkg ->
247
+ Hashtbl. replace packages rootPath pkg;
248
+ Some pkg
249
+ | None -> None ))
240
250
| Some (`Bs rootPath ) -> (
241
251
match newBsPackage ~root Path with
242
252
| None -> None
243
253
| Some package ->
244
- SharedTypes.StateSync. with_lock (fun () ->
245
- Hashtbl. replace state.rootForUri uri package.rootPath;
246
- Hashtbl. replace state.packagesByRoot package.rootPath package;
247
- Some package)))
254
+ Hashtbl. replace roots uri package.rootPath;
255
+ Hashtbl. replace packages package.rootPath package;
256
+ Some package))
0 commit comments