From 506f85401f4d140eaeaa8fd70d1e41e1024f63fc Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 1 May 2024 17:03:17 +0200 Subject: [PATCH] [hxb] load less things during display requests 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. --- src/compiler/hxb/hxbReader.ml | 71 ++++++++++++++++++++---------- src/compiler/hxb/hxbWriter.ml | 29 ++++++++++++ src/compiler/server.ml | 36 ++++++++++----- src/context/display/displayJson.ml | 2 +- src/core/tFunctions.ml | 11 +++++ src/core/tType.ml | 2 + src/typing/macroContext.ml | 8 ++-- 7 files changed, 118 insertions(+), 41 deletions(-) diff --git a/src/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index 7286185fa71..4dbb3587ae0 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -4,6 +4,8 @@ open Type open HxbData open HxbReaderApi +exception IgnoredModule + type field_reader_context = { t_pool : Type.t Array.t; pos : pos ref; @@ -153,6 +155,7 @@ class hxb_reader = object(self) val mutable api = Obj.magic "" val mutable current_module = null_module + val mutable sig_only = false val mutable ch = BytesWithPosition.create (Bytes.create 0) val mutable has_string_pool = (string_pool <> None) @@ -176,9 +179,23 @@ class hxb_reader val mutable field_type_parameter_offset = 0 val empty_anon = mk_anon (ref Closed) + method is_sig_dep (sig_deps : (int,module_dep) PMap.t option) (path : path) = match sig_deps with + | None -> + true + | Some deps -> + PMap.fold (fun md found -> found || md.md_path = path) deps false + + method is_module_ignored path = + sig_only + && current_module.m_path <> path + && not (self#is_sig_dep current_module.m_extra.m_sig_deps path) + method resolve_type pack mname tname = try - api#resolve_type pack mname tname + if self#is_module_ignored (pack,mname) then + raise IgnoredModule + else + api#resolve_type pack mname tname with Not_found -> dump_backtrace(); error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname))) @@ -1787,51 +1804,56 @@ class hxb_reader let l = read_uleb128 ch in classes <- (Array.init l (fun i -> let (pack,mname,tname) = self#read_full_path in - match self#resolve_type pack mname tname with - | TClassDecl c -> - c - | _ -> - error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname))) + try (match self#resolve_type pack mname tname with + | TClassDecl c -> + c + | _ -> + error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname))) + ) with IgnoredModule -> null_class )) method read_abr = let l = read_uleb128 ch in abstracts <- (Array.init l (fun i -> let (pack,mname,tname) = self#read_full_path in - match self#resolve_type pack mname tname with - | TAbstractDecl a -> - a - | _ -> - error ("Unexpected type where abstract was expected: " ^ (s_type_path (pack,tname))) + try (match self#resolve_type pack mname tname with + | TAbstractDecl a -> + a + | _ -> + error ("Unexpected type where abstract was expected: " ^ (s_type_path (pack,tname))) + ) with IgnoredModule -> null_abstract )) method read_enr = let l = read_uleb128 ch in enums <- (Array.init l (fun i -> let (pack,mname,tname) = self#read_full_path in - match self#resolve_type pack mname tname with - | TEnumDecl en -> - en - | _ -> - error ("Unexpected type where enum was expected: " ^ (s_type_path (pack,tname))) + try (match self#resolve_type pack mname tname with + | TEnumDecl en -> + en + | _ -> + error ("Unexpected type where enum was expected: " ^ (s_type_path (pack,tname))) + ) with IgnoredModule -> null_enum )) method read_tdr = let l = read_uleb128 ch in typedefs <- (Array.init l (fun i -> let (pack,mname,tname) = self#read_full_path in - match self#resolve_type pack mname tname with - | TTypeDecl tpd -> - tpd - | _ -> - error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname))) + try (match self#resolve_type pack mname tname with + | TTypeDecl tpd -> + tpd + | _ -> + error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname))) + ) with IgnoredModule -> null_typedef )) method read_mdr = let length = read_uleb128 ch in for _ = 0 to length - 1 do let path = self#read_path in - ignore(api#resolve_module path) + if not (self#is_module_ignored path) then + ignore(api#resolve_module path) done method read_mtf = @@ -2011,10 +2033,11 @@ class hxb_reader close() method read_chunks (new_api : hxb_reader_api) (chunks : cached_chunks) = - fst (self#read_chunks_until new_api chunks EOM) + fst (self#read_chunks_until new_api chunks EOM false) - method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk = + method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk skip_expr = api <- new_api; + sig_only <- skip_expr; let rec loop = function | (kind,data) :: chunks -> ch <- BytesWithPosition.create data; diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index f105d1e68b5..5f0d9c6f0ce 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -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; @@ -866,20 +869,29 @@ module HxbWriter = struct (* References *) + let maybe_add_sig_dep writer m = + if not writer.in_expr then + if 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) = @@ -1785,15 +1797,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; @@ -2240,6 +2258,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; @@ -2277,6 +2304,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 (); diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 502582f920b..6e3b709424b 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -309,6 +309,7 @@ let check_module sctx com m_path m_extra p = let find_module_extra sign mpath = (com.cs#get_context sign)#find_module_extra mpath in + let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m_extra.m_file) in let check_dependencies () = PMap.iter (fun _ mdep -> let sign = mdep.md_sign in @@ -321,7 +322,11 @@ 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; + ) (match m_extra.m_sig_deps with + | None -> m_extra.m_deps + | Some _ when com.is_macro_context || com.display.dms_full_typing || is_display_file -> m_extra.m_deps + | Some deps -> deps + ); in let check () = try @@ -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 sig_only = not (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 + let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until sig_only 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 not sig_only 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__ @@ -490,6 +496,7 @@ 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 is_display_file = 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 @@ -508,7 +515,11 @@ 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 + ) (match m.m_extra.m_sig_deps with + | None -> m.m_extra.m_deps + | Some _ when com.is_macro_context || com.display.dms_full_typing || is_display_file -> m.m_extra.m_deps + | Some deps -> deps + ); ) end in @@ -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 sig_only = not (com.is_macro_context || com.display.dms_full_typing || is_display_file) in let api = match com.hxb_reader_api with | Some api -> api @@ -578,16 +591,15 @@ and type_module sctx com delay mpath p = in let f_next chunks until = let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in - let r = reader#read_chunks_until api chunks until in + let r = reader#read_chunks_until api chunks until sig_only 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 not sig_only then ignore(f_next chunks EOM) + else delay (fun () -> ignore(f_next chunks EOF)); add_modules true m; | Some reason -> skip mpath reason diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 8c85e6aa722..e3065e3c9a0 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -140,7 +140,7 @@ class hxb_reader_api_com with Not_found -> let mc = cc#get_hxb_module m_path in let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in - fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM)) + fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if headers_only then MTF else EOM) headers_only) method basic_types = com.basic diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index afbe64b7294..03e5126fe85 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -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; @@ -297,6 +299,15 @@ let add_dependency ?(skip_postprocess=false) m mdep = if not skip_postprocess then m.m_extra.m_processed <- 0 end +(* TODO: cleanup *) +let add_manual_dependency ?(skip_postprocess=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; + 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 + let arg_name (a,_) = a.v_name let t_infos t : tinfos = diff --git a/src/core/tType.ml b/src/core/tType.ml index b7122360cf5..30785bb8284 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -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; diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index d9f307b2b0e..4b742239073 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -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_manual_dependency mnew mdep; ctx.com.module_nonexistent_lut#clear; in add false ctx; @@ -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_manual_dependency mnew ctx.m.curmod; ctx.com.module_nonexistent_lut#clear; end ); @@ -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_manual_dependency m (TypeloadCacheHook.create_fake_module ctx.com file); ); MacroApi.current_module = (fun() -> ctx.m.curmod @@ -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_manual_dependency ctx.m.curmod mloaded; do_call_macro ctx.com api cpath f args p in mctx, meth, call