[hxb] load less dependencies during display requests (#11650)

* [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.

* Introduce md_origin instead of m_manual_deps

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,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) =
@@ -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;
@@ -2240,6 +2257,19 @@ 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.empty in
+		PMap.iter (fun id mdep -> match mdep.md_origin with
+			| MDepFromMacro -> sig_deps := PMap.add id mdep !sig_deps;
+			| _ -> ()
+		) m.m_extra.m_deps;
+		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; md_origin = MDepFromTyping} 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 +2307,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 ();

src/compiler/server.ml

@@ -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
@@ -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
@@ -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__
@@ -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
@@ -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
@@ -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
@@ -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

src/core/tFunctions.ml

@@ -171,6 +171,7 @@ let module_extra file sign time kind added policy =
 		m_time = time;
 		m_processed = 0;
 		m_deps = PMap.empty;
+		m_sig_deps = None;
 		m_kind = kind;
 		m_cache_bound_objects = DynArray.create ();
 		m_features = Hashtbl.create 0;
@@ -290,9 +291,9 @@ let null_abstract = {
 	a_enum = false;
 }
 
-let add_dependency ?(skip_postprocess=false) m mdep =
+let add_dependency ?(skip_postprocess=false) m mdep origin =
 	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_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; md_origin = origin}) m.m_extra.m_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

src/core/tType.ml

@@ -401,10 +401,15 @@ and module_def_display = {
 	mutable m_import_positions : (pos,bool ref) PMap.t;
 }
 
+and module_dep_origin =
+	| MDepFromTyping
+	| MDepFromMacro
+
 and module_dep = {
 	md_sign : Digest.t;
 	md_kind : module_kind;
 	md_path : path;
+	md_origin : module_dep_origin
 }
 
 and module_def_extra = {
@@ -418,6 +423,7 @@ and module_def_extra = {
 	mutable m_checked : int;
 	mutable m_processed : int;
 	mutable m_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;

src/filters/exceptions.ml

@@ -39,7 +39,7 @@ let haxe_exception_static_call ctx method_name args p =
 		| TFun(_,t) -> t
 		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 	in
-	add_dependency ctx.typer.c.curclass.cl_module ctx.haxe_exception_class.cl_module;
+	add_dependency ctx.typer.c.curclass.cl_module ctx.haxe_exception_class.cl_module MDepFromTyping;
 	make_static_call ctx.typer ctx.haxe_exception_class method_field (fun t -> t) args return_type p
 
 (**
@@ -605,7 +605,7 @@ let insert_save_stacks tctx =
 				in
 				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
 				begin
-					add_dependency tctx.c.curclass.cl_module native_stack_trace_cls.cl_module;
+					add_dependency tctx.c.curclass.cl_module native_stack_trace_cls.cl_module MDepFromTyping;
 					make_static_call tctx native_stack_trace_cls method_field (fun t -> t) [catch_local] return_type catch_var.v_pos
 				end
 			else

src/filters/filters.ml

@@ -511,16 +511,16 @@ let update_cache_dependencies ~close_monomorphs com t =
 	let visited_anons = ref [] in
 	let rec check_t m t = match t with
 		| TInst(c,tl) ->
-			add_dependency m c.cl_module;
+			add_dependency m c.cl_module MDepFromTyping;
 			List.iter (check_t m) tl;
 		| TEnum(en,tl) ->
-			add_dependency m en.e_module;
+			add_dependency m en.e_module MDepFromTyping;
 			List.iter (check_t m) tl;
 		| TType(t,tl) ->
-			add_dependency m t.t_module;
+			add_dependency m t.t_module MDepFromTyping;
 			List.iter (check_t m) tl;
 		| TAbstract(a,tl) ->
-			add_dependency m a.a_module;
+			add_dependency m a.a_module MDepFromTyping;
 			List.iter (check_t m) tl;
 		| TFun(targs,tret) ->
 			List.iter (fun (_,_,t) -> check_t m t) targs;

src/optimization/inline.ml

@@ -96,7 +96,7 @@ let api_inline2 com c field params p =
 let api_inline ctx c field params p =
 	let mk_typeexpr path =
 		let m = (try ctx.com.module_lut#find path with Not_found -> die "" __LOC__) in
-		add_dependency ctx.m.curmod m;
+		add_dependency ctx.m.curmod m MDepFromTyping;
 		Option.get (ExtList.List.find_map (function
 			| TClassDecl cl when cl.cl_path = path -> Some (Texpr.Builder.make_static_this cl p)
 			| _ -> None

src/typing/fields.ml

@@ -488,7 +488,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) =
 			with Not_found ->
 				match loop ctx.g.global_using with
 				| AKUsingField { se_access = { fa_host = FHStatic c } } as acc ->
-					add_dependency ctx.m.curmod c.cl_module;
+					add_dependency ctx.m.curmod c.cl_module MDepFromTyping;
 					acc
 				| _ -> die "" __LOC__
 		) t e in

src/typing/generic.ml

@@ -87,7 +87,7 @@ let rec generic_substitute_type' gctx allow_expr t =
 		(* maybe loop, or generate cascading generics *)
 		let info = gctx.ctx.g.get_build_info gctx.ctx (TClassDecl c2) gctx.p in
 		let t = info.build_apply (List.map (generic_substitute_type' gctx true) tl2) in
-		(match follow t,gctx.mg with TInst(c,_), Some m -> add_dependency m c.cl_module | _ -> ());
+		(match follow t,gctx.mg with TInst(c,_), Some m -> add_dependency m c.cl_module MDepFromTyping | _ -> ());
 		t
 	| _ ->
 		try
@@ -188,8 +188,8 @@ let static_method_container gctx c cf p =
 		let cg = mk_class mg (pack,name) c.cl_pos c.cl_name_pos in
 		mg.m_types <- [TClassDecl cg];
 		ctx.com.module_lut#add mg.m_path mg;
-		add_dependency mg m;
-		add_dependency ctx.m.curmod mg;
+		add_dependency mg m MDepFromTyping;
+		add_dependency ctx.m.curmod mg MDepFromTyping;
 		cg
 
 let set_type_parameter_dependencies mg tl =
@@ -220,7 +220,7 @@ let set_type_parameter_dependencies mg tl =
 			loop ret
 		end
 	and add_dep m tl =
-		add_dependency mg m;
+		add_dependency mg m MDepFromTyping;
 		List.iter loop tl
 	in
 	List.iter loop tl
@@ -320,8 +320,8 @@ let build_generic_class ctx c p tl =
 		cg.cl_meta <- (Meta.NoDoc,[],null_pos) :: cg.cl_meta;
 		mg.m_types <- [TClassDecl cg];
 		ctx.com.module_lut#add mg.m_path mg;
-		add_dependency mg m;
-		add_dependency ctx.m.curmod mg;
+		add_dependency mg m MDepFromTyping;
+		add_dependency ctx.m.curmod mg MDepFromTyping;
 		set_type_parameter_dependencies mg tl;
 		let build_field cf_old =
 			let params = List.map (fun ttp ->

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_dependency mnew mdep MDepFromMacro;
 				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_dependency mnew ctx.m.curmod MDepFromMacro;
 				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_dependency m (TypeloadCacheHook.create_fake_module ctx.com file) MDepFromMacro;
 		);
 		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_dependency ctx.m.curmod mloaded MDepFromMacro;
 		do_call_macro ctx.com api cpath f args p
 	in
 	mctx, meth, call

src/typing/typeload.ml

@@ -709,7 +709,7 @@ and init_meta_overloads ctx co cf =
 let t_iterator ctx p =
 	match load_qualified_type_def ctx [] "StdTypes" "Iterator" p with
 	| TTypeDecl t ->
-		add_dependency ctx.m.curmod t.t_module;
+		add_dependency ctx.m.curmod t.t_module MDepFromTyping;
 		let pt = spawn_monomorph ctx.e p in
 		apply_typedef t [pt], pt
 	| _ ->

src/typing/typeloadModule.ml

@@ -289,7 +289,7 @@ module ModuleLevel = struct
 			let decls = try
 				let r = com.parser_cache#find path in
 				let mimport = com.module_lut#find ([],path) in
-				if mimport.m_extra.m_kind <> MFake then add_dependency m mimport;
+				if mimport.m_extra.m_kind <> MFake then add_dependency m mimport MDepFromTyping;
 				r
 			with Not_found ->
 				if Sys.file_exists path then begin
@@ -300,7 +300,7 @@ module ModuleLevel = struct
 					List.iter (fun (d,p) -> match d with EImport _ | EUsing _ -> () | _ -> raise_typing_error "Only import and using is allowed in import.hx files" p) r;
 					let m_import = make_import_module path r in
 					add_module com m_import p;
-					add_dependency m m_import;
+					add_dependency m m_import MDepFromTyping;
 					r
 				end else begin
 					let r = [] in
@@ -709,7 +709,7 @@ let type_types_into_module com g m tdecls p =
 	let imports_and_usings,decls = ModuleLevel.create_module_types ctx_m m tdecls p in
 	(* define the per-module context for the next pass *)
 	if ctx_m.g.std_types != null_module then begin
-		add_dependency m ctx_m.g.std_types;
+		add_dependency m ctx_m.g.std_types MDepFromTyping;
 		(* this will ensure both String and (indirectly) Array which are basic types which might be referenced *)
 		ignore(load_instance ctx_m (make_ptp (mk_type_path (["std"],"String")) null_pos) ParamNormal LoadNormal)
 	end;
@@ -847,7 +847,7 @@ and load_module' com g m p =
 
 let load_module ctx m p =
 	let m2 = load_module' ctx.com ctx.g m p in
-	add_dependency ~skip_postprocess:true ctx.m.curmod m2;
+	add_dependency ~skip_postprocess:true ctx.m.curmod m2 MDepFromTyping;
 	if ctx.pass = PTypeField then flush_pass ctx.g PConnectField ("load_module",fst m @ [snd m]);
 	m2