From 5473d7d83d27fb857313544d09b01189ee617e61 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Wed, 2 Oct 2024 09:38:14 +0200 Subject: [PATCH] [hxb] Continue display dependencies rework --- src/compiler/compilationCache.ml | 3 ++- src/compiler/hxb/hxbWriter.ml | 2 +- src/compiler/server.ml | 22 +++++++++++++++++----- src/core/display/displayPosition.ml | 10 ++++++++++ src/core/tFunctions.ml | 1 + src/core/tType.ml | 1 + 6 files changed, 32 insertions(+), 7 deletions(-) diff --git a/src/compiler/compilationCache.ml b/src/compiler/compilationCache.ml index 372f2c0e21b..17312d3ae1f 100644 --- a/src/compiler/compilationCache.ml +++ b/src/compiler/compilationCache.ml @@ -104,7 +104,8 @@ class context_cache (index : int) (sign : Digest.t) = object(self) mc_min_chunks = HxbWriter.get_chunks min_writer; mc_extra = { m.m_extra with m_cache_state = MSGood; - m_sig_deps = Some (HxbWriter.get_dependencies min_writer) + m_sig_deps = Some (HxbWriter.get_dependencies min_writer); + m_all_deps = PMap.fold (fun mdep acc -> (mdep.md_path, mdep.md_sign) :: acc) (HxbWriter.get_dependencies writer) []; } } diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 0927e0c3de2..cb8c14312ac 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -870,7 +870,7 @@ module HxbWriter = struct (* References *) let maybe_add_sig_dep writer m = - if writer.minimal && m.m_path <> writer.current_module.m_path && not (List.exists (fun m' -> m'.m_path = m.m_path) writer.deps) then + if m.m_path <> writer.current_module.m_path && not (List.exists (fun m' -> m'.m_path = m.m_path) writer.deps) then writer.deps <- m :: writer.deps let write_class_ref writer (c : tclass) = diff --git a/src/compiler/server.ml b/src/compiler/server.ml index d959c9bb6d4..25003cf28fe 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -440,7 +440,8 @@ class hxb_reader_api_server 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";"until " ^ (string_of_chunk_kind until)] in + let macro = if com.is_macro_context then " (macro)" else "" in + let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until (not full_restore) in t_hxb(); r @@ -450,7 +451,8 @@ class hxb_reader_api_server (* 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. *) if full_restore then ignore(f_next chunks EOM) - else delay (fun () -> ignore(f_next chunks EOF)); + else if DisplayPosition.display_position#is_display_dependency m.m_path m.m_extra.m_sign then + delay (fun () -> ignore(f_next chunks EOF)); m | BadModule reason -> die (Printf.sprintf "Unexpected BadModule %s (%s)" (s_type_path path) (Printer.s_module_skip_reason reason)) __LOC__ @@ -569,17 +571,23 @@ and type_module sctx com delay mpath p = in the cache. The true cache state will be known after check_module. *) begin match check_module sctx mpath m.m_extra p with | None -> + (* TODO: does this help at all? *) + (* let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in *) + (* if is_display_file then DisplayPosition.display_position#set_display_module m.m_path m.m_extra; *) + add_modules false m; | Some reason -> skip m.m_path reason end | BinaryModule mc -> + let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key mc.mc_extra.m_file) in + if is_display_file then DisplayPosition.display_position#set_display_module mc.mc_path mc.mc_extra; + (* Similarly, we only know that a binary module wasn't explicitly tainted. Decode it only after checking dependencies. This means that the actual decoding never has any reason to fail. *) 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 -> @@ -590,16 +598,20 @@ and type_module sctx com delay mpath p = api in let f_next chunks until = - let t_hxb = Timer.timer ["server";"module cache";"hxb read";"until " ^ (string_of_chunk_kind until)] in + let macro = if com.is_macro_context then " (macro)" else "" in + let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in let r = reader#read_chunks_until api chunks until (not full_restore) in t_hxb(); r in + let m,chunks = f_next (if full_restore then mc.mc_chunks else mc.mc_min_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. *) if full_restore then ignore(f_next chunks EOM) - else delay (fun () -> ignore(f_next chunks EOF)); + else if DisplayPosition.display_position#is_display_dependency m.m_path m.m_extra.m_sign then + delay (fun () -> ignore(f_next chunks EOF)); add_modules true m; | Some reason -> skip mpath reason diff --git a/src/core/display/displayPosition.ml b/src/core/display/displayPosition.ml index fffdfe432b8..e904a9f2a23 100644 --- a/src/core/display/displayPosition.ml +++ b/src/core/display/displayPosition.ml @@ -10,6 +10,7 @@ class display_position_container = object (self) (** Current display position *) val mutable pos = null_pos + val mutable display_module : (path * TType.module_def_extra) option = None val mutable file_key = None val mutable file_keys = [] (** @@ -26,6 +27,14 @@ class display_position_container = file_key <- None; file_keys <- if p.pfile = DisplayProcessingGlobals.file_input_marker then [] else [Path.UniqueKey.create p.pfile] + method set_display_module path mc_extra = + display_module <- Some (path, mc_extra) + + method is_display_dependency path sign = match display_module with + (* That one is tricky.. usually when it's not set it's because it's being retyped *) + | None -> true + | Some m' -> List.mem (path,sign) (snd m').m_all_deps + method set_files files = file_keys <- files @@ -52,6 +61,7 @@ class display_position_container = *) method reset = pos <- null_pos; + display_module <- None; file_key <- None; file_keys <- [] (** diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 8440e7d8e25..e5d7aaff314 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -185,6 +185,7 @@ let module_extra file sign time kind added policy = m_processed = 0; m_deps = PMap.empty; m_sig_deps = None; + m_all_deps = []; m_kind = kind; m_cache_bound_objects = DynArray.create (); m_features = Hashtbl.create 0; diff --git a/src/core/tType.ml b/src/core/tType.ml index a038e4aaff8..fa8196a0263 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -440,6 +440,7 @@ and module_def_extra = { mutable m_processed : int; mutable m_deps : (int,module_dep) PMap.t; mutable m_sig_deps : (int,module_dep) PMap.t option; + mutable m_all_deps : (path * Digest.t) list; mutable m_kind : module_kind; mutable m_cache_bound_objects : cache_bound_object DynArray.t; mutable m_features : (string,bool) Hashtbl.t;