[hxb] Signature dependencies - part 2

src/compiler/hxb/hxbData.ml

@@ -27,7 +27,7 @@ type chunk_kind =
 	| MDF (* module foward *)
 	| MTF (* module types forward *)
 	(* Module type references *)
-	| MDR (* module references *)
+	| IMP (* imports *)
 	| CLR (* class references *)
 	| ENR (* enum references *)
 	| ABR (* abstract references *)
@@ -68,7 +68,7 @@ let string_of_chunk_kind = function
 	| DOC -> "DOC"
 	| MDF -> "MDF"
 	| MTF -> "MTF"
-	| MDR -> "MDR"
+	| IMP -> "IMP"
 	| CLR -> "CLR"
 	| ENR -> "ENR"
 	| ABR -> "ABR"
@@ -95,7 +95,7 @@ let chunk_kind_of_string = function
 	| "DOC" -> DOC
 	| "MDF" -> MDF
 	| "MTF" -> MTF
-	| "MDR" -> MDR
+	| "IMP" -> IMP
 	| "CLR" -> CLR
 	| "ENR" -> ENR
 	| "ABR" -> ABR

src/compiler/hxb/hxbReader.ml

@@ -152,6 +152,7 @@ class hxb_reader
 	(timers_enabled : bool)
 = object(self)
 	val mutable api = Obj.magic ""
+	val mutable minimal_restore = false
 	val mutable current_module = null_module
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
@@ -1827,7 +1828,7 @@ class hxb_reader
 				error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname)))
 		))
 
-	method read_mdr =
+	method read_imports =
 		let length = read_uleb128 ch in
 		for _ = 0 to length - 1 do
 			let path = self#read_path in
@@ -1942,8 +1943,8 @@ class hxb_reader
 		| MTF ->
 			current_module.m_types <- self#read_mtf;
 			api#add_module current_module;
-		| MDR ->
-			self#read_mdr;
+		| IMP ->
+			if not minimal_restore then self#read_imports;
 		| CLR ->
 			self#read_clr;
 		| ENR ->
@@ -2011,10 +2012,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 minimal_restore' =
 		api <- new_api;
+		minimal_restore <- minimal_restore';
 		let rec loop = function
 			| (kind,data) :: chunks ->
 				ch <- BytesWithPosition.create data;
@@ -2027,6 +2029,7 @@ class hxb_reader
 
 	method read (new_api : hxb_reader_api) (bytes : bytes) =
 		api <- new_api;
+		minimal_restore <- false;
 		ch <- BytesWithPosition.create bytes;
 		if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then
 			raise (HxbFailure "magic");

src/compiler/hxb/hxbWriter.ml

@@ -468,7 +468,7 @@ module HxbWriter = struct
 		let initial_size = match kind with
 			| EOT | EOF | EOM -> 0
 			| MDF -> 16
-			| MTF | MDR | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64
+			| MTF | IMP | CLR | END | ABD | ENR | ABR | TDR | EFR | CFR | AFD -> 64
 			| OFR | OFD | OBD | CLD | TDD | EFD -> 128
 			| STR | DOC -> 256
 			| CFD | EXD -> 512
@@ -2240,34 +2240,35 @@ module HxbWriter = struct
 		end;
 
 		begin
-			let deps = DynArray.create () in
+			let imports = DynArray.create () in
 			PMap.iter (fun _ mdep ->
-				match mdep.md_kind with
-				| MCode | MExtern when mdep.md_sign = m.m_extra.m_sign ->
-					DynArray.add deps mdep.md_path;
+				match mdep.md_kind, mdep.md_origin with
+				| (MCode | MExtern), MDepFromImport when mdep.md_sign = m.m_extra.m_sign ->
+					DynArray.add imports mdep.md_path;
 				| _ ->
 					()
 			) m.m_extra.m_deps;
-			if DynArray.length deps > 0 then begin
-				start_chunk writer MDR;
-				Chunk.write_uleb128 writer.chunk (DynArray.length deps);
+
+			if DynArray.length imports > 0 then begin
+				start_chunk writer IMP;
+				Chunk.write_uleb128 writer.chunk (DynArray.length imports);
 				DynArray.iter (fun path ->
 					write_path writer path
-				) deps
-			end
+				) imports
+			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;
+		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;

src/compiler/server.ml

@@ -427,7 +427,7 @@ class hxb_reader_api_server
 			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
+				let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until (not full_restore) in
 				t_hxb();
 				r
 			in
@@ -591,7 +591,7 @@ 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 (not full_restore) in
 						t_hxb();
 						r
 					in

src/context/display/displayJson.ml

@@ -105,7 +105,7 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 end
 
 class hxb_reader_api_com
-	~(headers_only : bool)
+	~(minimal_restore : bool)
 	(com : Common.context)
 	(cc : CompilationCache.context_cache)
 = object(self)
@@ -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 minimal_restore then MTF else EOM) minimal_restore)
 
 	method basic_types =
 		com.basic
@@ -152,8 +152,8 @@ class hxb_reader_api_com
 		false
 end
 
-let find_module ~(headers_only : bool) com cc path =
-	(new hxb_reader_api_com ~headers_only com cc)#find_module path
+let find_module ~(minimal_restore : bool) com cc path =
+	(new hxb_reader_api_com ~minimal_restore com cc)#find_module path
 
 type handler_context = {
 	com : Common.context;
@@ -352,19 +352,19 @@ let handler =
 			let cs = hctx.display#get_cs in
 			let cc = cs#get_context sign in
 			let m = try
-				find_module ~headers_only:true hctx.com cc path
+				find_module ~minimal_restore:true hctx.com cc path
 			with Not_found ->
 				hctx.send_error [jstring "No such module"]
 			in
-			hctx.send_result (generate_module (cc#get_hxb) (find_module ~headers_only:true hctx.com cc) m)
+			hctx.send_result (generate_module (cc#get_hxb) (find_module ~minimal_restore:true hctx.com cc) m)
 		);
 		"server/type", (fun hctx ->
 			let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
 			let path = Path.parse_path (hctx.jsonrpc#get_string_param "modulePath") in
 			let typeName = hctx.jsonrpc#get_string_param "typeName" in
 			let cc = hctx.display#get_cs#get_context sign in
 			let m = try
-				find_module ~headers_only:true hctx.com cc path
+				find_module ~minimal_restore:true hctx.com cc path
 			with Not_found ->
 				hctx.send_error [jstring "No such module"]
 			in

src/context/display/importHandling.ml

@@ -81,7 +81,7 @@ let init_import ctx path mode p =
 	| (tname,p2) :: rest ->
 		let p1 = (match pack with [] -> p2 | (_,p1) :: _ -> p1) in
 		let p_type = punion p1 p2 in
-		let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in
+		let md = ctx.g.do_load_module ~origin:MDepFromImport ctx (List.map fst pack,tname) p_type in
 		let types = md.m_types in
 		let not_private mt = not (t_infos mt).mt_private in
 		let error_private p = raise_typing_error "Importing private declarations from a module is not allowed" p in
@@ -267,7 +267,7 @@ let handle_using ctx path p =
 	in
 	let types = (match t.tsub with
 		| None ->
-			let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in
+			let md = ctx.g.do_load_module ~origin:MDepFromImport ctx (t.tpackage,t.tname) p in
 			let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in
 			Option.map_default (fun c -> (TClassDecl c) :: types) types md.m_statics
 		| Some _ ->

src/context/typecore.ml

@@ -127,7 +127,7 @@ type typer_globals = {
 	(* api *)
 	do_macro : typer -> macro_mode -> path -> string -> expr list -> pos -> macro_result;
 	do_load_macro : typer -> bool -> path -> string -> pos -> ((string * bool * t) list * t * tclass * Type.tclass_field);
-	do_load_module : typer -> path -> pos -> module_def;
+	do_load_module : ?origin:module_dep_origin -> typer -> path -> pos -> module_def;
 	do_load_type_def : typer -> pos -> type_path -> module_type;
 	get_build_info : typer -> module_type -> pos -> build_info;
 	do_format_string : typer -> string -> pos -> Ast.expr;

src/core/tPrinting.ml

@@ -612,6 +612,11 @@ module Printer = struct
 		| MExtern -> "MExtern"
 		| MImport -> "MImport"
 
+	let s_module_origin = function
+		| MDepFromImport -> "MDepFromImport"
+		| MDepFromTyping -> "MDepFromTyping"
+		| MDepFromMacro -> "MDepFromMacro"
+
 	let s_module_tainting_reason = function
 		| CheckDisplayFile -> "check_display_file"
 		| ServerInvalidate -> "server/invalidate"

src/core/tType.ml

@@ -403,6 +403,7 @@ and module_def_display = {
 
 and module_dep_origin =
 	| MDepFromTyping
+	| MDepFromImport
 	| MDepFromMacro
 
 and module_dep = {

src/typing/macroContext.ml

@@ -400,7 +400,7 @@ let make_macro_api ctx mctx p =
 		MacroApi.get_module = (fun s ->
 			typing_timer ctx false (fun ctx ->
 				let path = parse_path s in
-				let m = List.map type_of_module_type (TypeloadModule.load_module ctx path p).m_types in
+				let m = List.map type_of_module_type (TypeloadModule.load_module ~origin:MDepFromMacro ctx path p).m_types in
 				m
 			)
 		);
@@ -466,7 +466,7 @@ let make_macro_api ctx mctx p =
 				| _ -> false
 			in
 			let add is_macro ctx =
-				let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in
+				let mdep = Option.map_default (fun s -> TypeloadModule.load_module ~origin:MDepFromMacro 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 MDepFromMacro;
@@ -506,7 +506,7 @@ let make_macro_api ctx mctx p =
 		MacroApi.module_dependency = (fun mpath file ->
 			let m = typing_timer ctx false (fun ctx ->
 				let old_deps = ctx.m.curmod.m_extra.m_deps in
-				let m = TypeloadModule.load_module ctx (parse_path mpath) p in
+				let m = TypeloadModule.load_module ~origin:MDepFromMacro ctx (parse_path mpath) p in
 				ctx.m.curmod.m_extra.m_deps <- old_deps;
 				m
 			) in
@@ -582,8 +582,8 @@ let make_macro_api ctx mctx p =
 
 let init_macro_interp mctx mint =
 	let p = null_pos in
-	ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Expr") p);
-	ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Type") p);
+	ignore(TypeloadModule.load_module ~origin:MDepFromMacro mctx (["haxe";"macro"],"Expr") p);
+	ignore(TypeloadModule.load_module ~origin:MDepFromMacro mctx (["haxe";"macro"],"Type") p);
 	Interp.init mint;
 	macro_interp_cache := Some mint
 
@@ -739,7 +739,7 @@ let load_macro_module mctx com cpath display p =
 	(* Temporarily enter display mode while typing the macro. *)
 	let old = mctx.com.display in
 	if display then mctx.com.display <- com.display;
-	let mloaded = TypeloadModule.load_module mctx m p in
+	let mloaded = TypeloadModule.load_module ~origin:MDepFromMacro mctx m p in
 	mctx.m <- {
 		curmod = mloaded;
 		import_resolution = new resolution_list ["import";s_type_path cpath];

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 MDepFromTyping;
+				if mimport.m_extra.m_kind <> MFake then add_dependency m mimport MDepFromImport;
 				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 MDepFromTyping;
+					add_dependency m m_import MDepFromImport;
 					r
 				end else begin
 					let r = [] in
@@ -845,9 +845,9 @@ and load_module' com g m p =
 			let is_extern = !is_extern in
 			type_module com g m file ~is_extern decls p
 
-let load_module ctx m p =
+let load_module ?(origin:module_dep_origin = MDepFromTyping) ctx m p =
 	let m2 = load_module' ctx.com ctx.g m p in
-	add_dependency ~skip_postprocess:true ctx.m.curmod m2 MDepFromTyping;
+	add_dependency ~skip_postprocess:true ctx.m.curmod m2 origin;
 	if ctx.pass = PTypeField then flush_pass ctx.g PConnectField ("load_module",fst m @ [snd m]);
 	m2