[Hxb] Optimistic display requests

src-json/define.json

@@ -71,6 +71,11 @@
 		"define": "disable-hxb-cache",
 		"doc": "Use in-memory cache instead of hxb powered cache."
 	},
+	{
+		"name": "DisableHxbOptimizations",
+		"define": "disable-hxb-optimizations",
+		"doc": "Disable shortcuts used by hxb cache to speed up display requests."
+	},
 	{
 		"name": "DisableUnicodeStrings",
 		"define": "disable-unicode-strings",

src/compiler/compilationCache.ml

@@ -93,7 +93,7 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 				mc_path = path;
 				mc_id = m.m_id;
 				mc_chunks = chunks;
-				mc_extra = { m.m_extra with m_cache_state = MSGood }
+				mc_extra = { m.m_extra with m_cache_state = MSGood; m_display_deps = None }
 			}
 
 	method cache_module_in_memory path m =

src/compiler/hxb/hxbReader.ml

@@ -152,7 +152,7 @@ class hxb_reader
 	(timers_enabled : bool)
 = object(self)
 	val mutable api = Obj.magic ""
-	val mutable minimal_restore = false
+	val mutable full_restore = true
 	val mutable current_module = null_module
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
@@ -179,7 +179,13 @@ class hxb_reader
 
 	method resolve_type pack mname tname =
 		try
-			api#resolve_type pack mname tname
+			let mt = api#resolve_type pack mname tname in
+			if not full_restore then begin
+				let mdep = (t_infos mt).mt_module in
+				if mdep != null_module && current_module.m_path != mdep.m_path then
+					current_module.m_extra.m_display_deps <- Some (PMap.add mdep.m_id (create_dependency mdep MDepFromTyping) (Option.get current_module.m_extra.m_display_deps))
+			end;
+			mt
 		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)))
@@ -763,9 +769,9 @@ class hxb_reader
 			)
 		| 12 ->
 			let a = self#read_abstract_ref in
-			self#make_lazy_type_dynamic (fun () ->
+			(* self#make_lazy_type_dynamic (fun () -> *)
 				TType(abstract_module_type (Lazy.force a) [],[])
-			)
+			(* ) *)
 		| 13 ->
 			let e = self#read_expr in
 			let c = {null_class with cl_kind = KExpr e; cl_module = current_module } in
@@ -892,28 +898,28 @@ class hxb_reader
 			)
 		| 70 ->
 			let a = self#read_abstract_ref in
-			self#make_lazy_type_dynamic (fun () ->
+			(* self#make_lazy_type_dynamic (fun () -> *)
 				TAbstract(Lazy.force a,[])
-			)
+			(* ) *)
 		| 71 ->
 			let a = self#read_abstract_ref in
 			let t1 = self#read_type_instance in
-			self#make_lazy_type_dynamic (fun () ->
+			(* self#make_lazy_type_dynamic (fun () -> *)
 				TAbstract(Lazy.force a,[t1])
-			)
+			(* ) *)
 		| 72 ->
 			let a = self#read_abstract_ref in
 			let t1 = self#read_type_instance in
 			let t2 = self#read_type_instance in
-			self#make_lazy_type_dynamic (fun () ->
+			(* self#make_lazy_type_dynamic (fun () -> *)
 				TAbstract(Lazy.force a,[t1;t2])
-			)
+			(* ) *)
 		| 79 ->
 			let a = self#read_abstract_ref in
 			let tl = self#read_types in
-			self#make_lazy_type_dynamic (fun () ->
+			(* self#make_lazy_type_dynamic (fun () -> *)
 				TAbstract(Lazy.force a,tl)
-			)
+			(* ) *)
 		| 80 ->
 			empty_anon
 		| 81 ->
@@ -1382,8 +1388,9 @@ class hxb_reader
 	method read_class_field_forward =
 		let name = self#read_string in
 		let pos,name_pos = self#read_pos_pair in
+		let cf_meta = self#read_metadata in
 		let overloads = self#read_list (fun () -> self#read_class_field_forward) in
-		{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos; cf_overloads = overloads }
+		{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos; cf_overloads = overloads; cf_meta = cf_meta }
 
 	method start_texpr =
 		begin match read_byte ch with
@@ -1441,7 +1448,6 @@ class hxb_reader
 		let flags = read_uleb128 ch in
 
 		let doc = self#read_option (fun () -> self#read_documentation) in
-		cf.cf_meta <- self#read_metadata;
 		let kind = self#read_field_kind in
 
 		let expr,expr_unoptimized = match read_byte ch with
@@ -2020,11 +2026,12 @@ class hxb_reader
 			assert(has_string_pool);
 			current_module <- self#read_mdf;
 			incr stats.modules_partially_restored;
+			if not full_restore then current_module.m_extra.m_display_deps <- Some PMap.empty
 		| MTF ->
 			current_module.m_types <- self#read_mtf;
 			api#add_module current_module;
 		| IMP ->
-			if not minimal_restore then self#read_imports;
+			if full_restore then self#read_imports;
 		| CLR ->
 			self#read_clr;
 		| ENR ->
@@ -2092,11 +2099,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 false)
+		fst (self#read_chunks_until new_api chunks EOM true)
 
-	method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk minimal_restore' =
+	method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk full_restore' =
 		api <- new_api;
-		minimal_restore <- minimal_restore';
+		full_restore <- full_restore';
 		let rec loop = function
 			| (kind,data) :: chunks ->
 				ch <- BytesWithPosition.create data;
@@ -2109,7 +2116,7 @@ class hxb_reader
 
 	method read (new_api : hxb_reader_api) (bytes : bytes) =
 		api <- new_api;
-		minimal_restore <- false;
+		full_restore <- true;
 		ch <- BytesWithPosition.create bytes;
 		if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then
 			raise (HxbFailure "magic");

src/compiler/hxb/hxbWriter.ml

@@ -415,9 +415,6 @@ 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;
@@ -870,28 +867,20 @@ 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) =
@@ -1757,6 +1746,7 @@ module HxbWriter = struct
 	and write_class_field_forward writer cf =
 		Chunk.write_string writer.chunk cf.cf_name;
 		write_pos_pair writer cf.cf_pos cf.cf_name_pos;
+		write_metadata writer cf.cf_meta;
 		Chunk.write_list writer.chunk cf.cf_overloads (fun cf ->
 			write_class_field_forward writer cf;
 		);
@@ -1805,7 +1795,6 @@ module HxbWriter = struct
 		write_type_instance writer cf.cf_type;
 		Chunk.write_uleb128 writer.chunk cf.cf_flags;
 		maybe_write_documentation writer cf.cf_doc;
-		write_metadata writer cf.cf_meta;
 		write_field_kind writer cf.cf_kind;
 		let expr_chunk = match cf.cf_expr with
 			| None ->
@@ -1814,21 +1803,15 @@ 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;
@@ -2276,19 +2259,6 @@ 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
-		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;
-		PMap.iter (fun id mdep -> match mdep.md_kind, mdep.md_origin with
-			| (MCode | MExtern), MDepFromMacro when mdep.md_sign = m.m_extra.m_sign -> sig_deps := PMap.add id mdep !sig_deps;
-			| _ -> ()
-		) m.m_extra.m_deps;
-		m.m_extra.m_sig_deps <- Some !sig_deps;
-
 		start_chunk writer EOT;
 		start_chunk writer EOF;
 		start_chunk writer EOM;
@@ -2326,8 +2296,6 @@ 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 ();