Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[hxb] Ignore invalidations during display requests #11660

Merged
merged 5 commits into from
May 10, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 20 additions & 3 deletions src/compiler/compilationCache.ml
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,7 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
val files : (Path.UniqueKey.t,cached_file) Hashtbl.t = Hashtbl.create 0
val modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
val binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
val tmp_binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
val string_pool = StringPool.create ()
val removed_files = Hashtbl.create 0
val mutable json = JNull
Expand Down Expand Up @@ -67,8 +68,18 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
method find_module_opt path =
Hashtbl.find_opt modules path

method get_hxb_module path =
try Hashtbl.find tmp_binary_cache path
with Not_found ->
let mc = Hashtbl.find binary_cache path in
let m_extra = { mc.mc_extra with m_deps = mc.mc_extra.m_deps } in
let mc = { mc with mc_extra = m_extra } in
Hashtbl.add tmp_binary_cache path mc;
mc

method find_module_extra path =
try (Hashtbl.find modules path).m_extra with Not_found -> (Hashtbl.find binary_cache path).mc_extra
try (Hashtbl.find modules path).m_extra
with Not_found -> (self#get_hxb_module path).mc_extra

method cache_module config warn anon_identification path m =
match m.m_extra.m_kind with
Expand All @@ -85,8 +96,12 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
mc_extra = { m.m_extra with m_cache_state = MSGood }
}

method clear_temp_cache =
Hashtbl.clear tmp_binary_cache

method clear_cache =
Hashtbl.clear modules
Hashtbl.clear modules;
self#clear_temp_cache

(* initialization *)

Expand All @@ -101,7 +116,6 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
method get_hxb = binary_cache
method get_string_pool = string_pool
method get_string_pool_arr = string_pool.items.arr
method get_hxb_module path = Hashtbl.find binary_cache path

(* TODO handle hxb cache there too *)
method get_removed_files = removed_files
Expand Down Expand Up @@ -155,6 +169,9 @@ class cache = object(self)

(* contexts *)

method clear_temp_cache =
Hashtbl.iter (fun _ ctx -> ctx#clear_temp_cache) contexts

method get_context sign =
try
Hashtbl.find contexts sign
Expand Down
35 changes: 18 additions & 17 deletions src/compiler/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -391,6 +391,20 @@ let check_module sctx com m_path m_extra p =
end;
state

let get_hxb_module com cc path =
try
let mc = cc#get_hxb_module path in
if not com.is_macro_context && not com.display.dms_full_typing && not (DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key mc.mc_extra.m_file)) then begin
mc.mc_extra.m_cache_state <- MSGood;
BinaryModule mc
end else
begin match mc.mc_extra.m_cache_state with
| MSBad reason -> BadModule reason
| _ -> BinaryModule mc
end
with Not_found ->
NoModule

class hxb_reader_api_server
(com : Common.context)
(cc : context_cache)
Expand Down Expand Up @@ -439,21 +453,14 @@ class hxb_reader_api_server
else delay (fun () -> ignore(f_next chunks EOF));
m
| BadModule reason ->
die (Printf.sprintf "Unexpected BadModule %s" (s_type_path path)) __LOC__
die (Printf.sprintf "Unexpected BadModule %s (%s)" (s_type_path path) (Printer.s_module_skip_reason reason)) __LOC__
| NoModule ->
die (Printf.sprintf "Unexpected NoModule %s" (s_type_path path)) __LOC__

method find_module (m_path : path) =
try
GoodModule (com.module_lut#find m_path)
with Not_found -> try
let mc = cc#get_hxb_module m_path in
begin match mc.mc_extra.m_cache_state with
| MSBad reason -> BadModule reason
| _ -> BinaryModule mc
end
with Not_found ->
NoModule
with Not_found -> get_hxb_module com cc m_path

method basic_types =
com.basic
Expand Down Expand Up @@ -553,14 +560,7 @@ and type_module sctx com delay mpath p =
| MSBad reason -> BadModule reason
| _ -> GoodModule m
end;
with Not_found -> try
let mc = cc#get_hxb_module m_path in
begin match mc.mc_extra.m_cache_state with
| MSBad reason -> BadModule reason
| _ -> BinaryModule mc
end
with Not_found ->
NoModule
with Not_found -> get_hxb_module com cc m_path
in
(* Should not raise anything! *)
let m = match find_module_in_cache cc mpath p with
Expand Down Expand Up @@ -640,6 +640,7 @@ let after_save sctx ctx =
maybe_cache_context sctx ctx.com

let after_compilation sctx ctx =
sctx.cs#clear_temp_cache;
()

let mk_length_prefixed_communication allow_nonblock chin chout =
Expand Down
Loading