Skip to content

Commit

Permalink
[hxb] load less things during display requests
Browse files Browse the repository at this point in the history 
Note that this still loads a lot of dependencies that are not really
needed for display requests, but those are harder to skip without
breaking everything.
  • Loading branch information
@kLabz
kLabz committed May 2, 2024
1 parent 984c6e9 commit 5c43ad9
Show file tree
Hide file tree
Showing 5 changed files with 60 additions and 15 deletions.
28 changes: 28 additions & 0 deletions src/compiler/hxb/hxbWriter.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -415,6 +415,9 @@ type hxb_writer = {
docs : StringPool.t;
mutable chunk : Chunk.t;

mutable in_expr : bool;
mutable sig_deps : module_def list;

classes : (path,tclass) Pool.t;
enums : (path,tenum) Pool.t;
typedefs : (path,tdef) Pool.t;
Expand Down Expand Up @@ -866,20 +869,28 @@ module HxbWriter = struct

(* References *)

let maybe_add_sig_dep writer m =
if not writer.in_expr && m.m_path <> writer.current_module.m_path && not (List.exists (fun m' -> m'.m_path = m.m_path) writer.sig_deps) then
writer.sig_deps <- m :: writer.sig_deps

let write_class_ref writer (c : tclass) =
let i = Pool.get_or_add writer.classes c.cl_path c in
maybe_add_sig_dep writer c.cl_module;
Chunk.write_uleb128 writer.chunk i

let write_enum_ref writer (en : tenum) =
let i = Pool.get_or_add writer.enums en.e_path en in
maybe_add_sig_dep writer en.e_module;
Chunk.write_uleb128 writer.chunk i

let write_typedef_ref writer (td : tdef) =
let i = Pool.get_or_add writer.typedefs td.t_path td in
maybe_add_sig_dep writer td.t_module;
Chunk.write_uleb128 writer.chunk i

let write_abstract_ref writer (a : tabstract) =
let i = Pool.get_or_add writer.abstracts a.a_path a in
maybe_add_sig_dep writer a.a_module;
Chunk.write_uleb128 writer.chunk i

let write_tmono_ref writer (mono : tmono) =
Expand Down Expand Up @@ -1785,15 +1796,21 @@ module HxbWriter = struct
| Some e when not write_expr_immediately ->
Chunk.write_u8 writer.chunk 2;
let fctx,close = start_texpr writer e.epos in
let old = writer.in_expr in
writer.in_expr <- true;
write_texpr writer fctx e;
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
writer.in_expr <- old;
let expr_chunk = close() in
Some expr_chunk
| Some e ->
Chunk.write_u8 writer.chunk 1;
let fctx,close = start_texpr writer e.epos in
let old = writer.in_expr in
writer.in_expr <- true;
write_texpr writer fctx e;
Chunk.write_option writer.chunk cf.cf_expr_unoptimized (write_texpr writer fctx);
writer.in_expr <- old;
let expr_pre_chunk,expr_chunk = close() in
Chunk.export_data expr_pre_chunk writer.chunk;
Chunk.export_data expr_chunk writer.chunk;
Expand Down Expand Up @@ -2240,6 +2257,15 @@ module HxbWriter = struct
end
end;

(* Note: this is only a start, and is still including a lot of dependencies *)
(* that are not actually needed for signature only. *)
let sig_deps = ref (PMap.map (fun m -> m) m.m_extra.m_manual_deps) in
List.iter (fun mdep ->
let dep = {md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind} in
sig_deps := PMap.add mdep.m_id dep !sig_deps;
) writer.sig_deps;
m.m_extra.m_sig_deps <- Some !sig_deps;

start_chunk writer EOT;
start_chunk writer EOF;
start_chunk writer EOM;
Expand Down Expand Up @@ -2277,6 +2303,8 @@ let create config string_pool warn anon_id =
chunks = DynArray.create ();
cp = cp;
has_own_string_pool;
sig_deps = [];
in_expr = false;
docs = StringPool.create ();
chunk = Obj.magic ();
classes = Pool.create ();
Expand Down
32 changes: 22 additions & 10 deletions src/compiler/server.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -310,6 +310,11 @@ let check_module sctx com m_path m_extra p =
(com.cs#get_context sign)#find_module_extra mpath
in
let check_dependencies () =
let full_restore =
com.is_macro_context
|| com.display.dms_full_typing
|| DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m_extra.m_file)
in
PMap.iter (fun _ mdep ->
let sign = mdep.md_sign in
let mpath = mdep.md_path in
Expand All @@ -321,7 +326,7 @@ let check_module sctx com m_path m_extra p =
match check mpath m2_extra with
| None -> ()
| Some reason -> raise (Dirty (DependencyDirty(mpath,reason)))
) m_extra.m_deps;
) (if full_restore then m_extra.m_deps else Option.default m_extra.m_deps m_extra.m_sig_deps)
in
let check () =
try
Expand Down Expand Up @@ -418,19 +423,20 @@ class hxb_reader_api_server
m
| BinaryModule mc ->
let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key mc.mc_extra.m_file) in
let full_restore = com.is_macro_context || com.display.dms_full_typing || is_display_file in
let f_next chunks until =
let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in
let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in
t_hxb();
r
in
let m,chunks = f_next mc.mc_chunks EOF in
let m,chunks = f_next mc.mc_chunks EOT in

(* We try to avoid reading expressions as much as possible, so we only do this for
our current display file if we're in display mode. *)
let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in
if is_display_file || com.display.dms_full_typing then ignore(f_next chunks EOM)
else delay (fun () -> ignore(f_next chunks EOM));
if full_restore then ignore(f_next chunks EOM)
else delay (fun () -> ignore(f_next chunks EOF));
m
| BadModule reason ->
die (Printf.sprintf "Unexpected BadModule %s" (s_type_path path)) __LOC__
Expand Down Expand Up @@ -490,6 +496,11 @@ let rec add_modules sctx com delay (m : module_def) (from_binary : bool) (p : po
if not from_binary || m != m then
com.module_lut#add m.m_path m;
handle_cache_bound_objects com m.m_extra.m_cache_bound_objects;
let full_restore =
com.is_macro_context
|| com.display.dms_full_typing
|| DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file)
in
PMap.iter (fun _ mdep ->
let mpath = mdep.md_path in
if mdep.md_sign = own_sign then begin
Expand All @@ -508,7 +519,7 @@ let rec add_modules sctx com delay (m : module_def) (from_binary : bool) (p : po
in
add_modules (tabs ^ " ") m0 m2
end
) m.m_extra.m_deps
) (if full_restore then m.m_extra.m_deps else Option.default m.m_extra.m_deps m.m_extra.m_sig_deps)
)
end
in
Expand Down Expand Up @@ -568,6 +579,8 @@ and type_module sctx com delay mpath p =
begin match check_module sctx mpath mc.mc_extra p with
| None ->
let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key mc.mc_extra.m_file) in
let full_restore = com.is_macro_context || com.display.dms_full_typing || is_display_file in
let api = match com.hxb_reader_api with
| Some api ->
api
Expand All @@ -582,12 +595,11 @@ and type_module sctx com delay mpath p =
t_hxb();
r
in
let m,chunks = f_next mc.mc_chunks EOF in
let m,chunks = f_next mc.mc_chunks EOT in
(* We try to avoid reading expressions as much as possible, so we only do this for
our current display file if we're in display mode. *)
let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in
if is_display_file || com.display.dms_full_typing then ignore(f_next chunks EOM)
else delay (fun () -> ignore(f_next chunks EOM));
if full_restore then ignore(f_next chunks EOM)
else delay (fun () -> ignore(f_next chunks EOF));
add_modules true m;
| Some reason ->
skip mpath reason
Expand Down
5 changes: 4 additions & 1 deletion src/core/tFunctions.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -171,6 +171,8 @@ let module_extra file sign time kind added policy =
m_time = time;
m_processed = 0;
m_deps = PMap.empty;
m_manual_deps = PMap.empty;
m_sig_deps = None;
m_kind = kind;
m_cache_bound_objects = DynArray.create ();
m_features = Hashtbl.create 0;
Expand Down Expand Up @@ -290,9 +292,10 @@ let null_abstract = {
a_enum = false;
}

let add_dependency ?(skip_postprocess=false) m mdep =
let add_dependency ?(skip_postprocess=false) ?(manual_dependency=false) m mdep =
if m != null_module && mdep != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin
m.m_extra.m_deps <- PMap.add mdep.m_id ({md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind}) m.m_extra.m_deps;
if manual_dependency then m.m_extra.m_manual_deps <- PMap.add mdep.m_id ({md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind}) m.m_extra.m_manual_deps;
(* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *)
if not skip_postprocess then m.m_extra.m_processed <- 0
end
Expand Down
2 changes: 2 additions & 0 deletions src/core/tType.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -418,6 +418,8 @@ and module_def_extra = {
mutable m_checked : int;
mutable m_processed : int;
mutable m_deps : (int,module_dep) PMap.t;
mutable m_manual_deps : (int,module_dep) PMap.t;
mutable m_sig_deps : (int,module_dep) PMap.t option;
mutable m_kind : module_kind;
mutable m_cache_bound_objects : cache_bound_object DynArray.t;
mutable m_features : (string,bool) Hashtbl.t;
Expand Down
8 changes: 4 additions & 4 deletions src/typing/macroContext.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -469,7 +469,7 @@ let make_macro_api ctx mctx p =
let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in
let mnew = TypeloadModule.type_module ctx.com ctx.g ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in
mnew.m_extra.m_kind <- if is_macro then MMacro else MFake;
add_dependency mnew mdep;
add_dependency ~manual_dependency:true mnew mdep;
ctx.com.module_nonexistent_lut#clear;
in
add false ctx;
Expand Down Expand Up @@ -499,7 +499,7 @@ let make_macro_api ctx mctx p =
with Not_found ->
let mnew = TypeloadModule.type_module ctx.com ctx.g mpath (Path.UniqueKey.lazy_path ctx.m.curmod.m_extra.m_file) types pos in
mnew.m_extra.m_kind <- MFake;
add_dependency mnew ctx.m.curmod;
add_dependency ~manual_dependency:true mnew ctx.m.curmod;
ctx.com.module_nonexistent_lut#clear;
end
);
Expand All @@ -510,7 +510,7 @@ let make_macro_api ctx mctx p =
ctx.m.curmod.m_extra.m_deps <- old_deps;
m
) in
add_dependency m (TypeloadCacheHook.create_fake_module ctx.com file);
add_dependency ~manual_dependency:true m (TypeloadCacheHook.create_fake_module ctx.com file);
);
MacroApi.current_module = (fun() ->
ctx.m.curmod
Expand Down Expand Up @@ -811,7 +811,7 @@ let load_macro ctx com mctx api display cpath f p =
let meth,mloaded = load_macro'' com mctx display cpath f p in
let _,_,{cl_path = cpath},_ = meth in
let call args =
add_dependency ctx.m.curmod mloaded;
add_dependency ~manual_dependency:true ctx.m.curmod mloaded;
do_call_macro ctx.com api cpath f args p
in
mctx, meth, call
Expand Down

0 comments on commit 5c43ad9

Please sign in to comment.