[macro] defineType / defineModule: allow redefining MSBad modules

Note: this hook should be moved somewhere else..

src/compiler/server.ml

@@ -779,8 +779,16 @@ let do_connect ip port args =
 	process();
 	if !has_error then exit 1
 
+let find_good_module_extra sctx com path =
+	let cc = CommonCache.get_cache com in
+	let m_extra = cc#find_module_extra path in
+	match check_module sctx com path m_extra null_pos with
+	| None -> m_extra
+	| Some _ -> raise Not_found
+
 let enable_cache_mode sctx =
 	type_module_hook := type_module sctx;
+	find_module_extra_hook := find_good_module_extra sctx;
 	ServerCompilationContext.ensure_macro_setup sctx;
 	TypeloadParse.parse_hook := parse_file sctx.cs
 

src/typing/macroContext.ml

@@ -464,9 +464,8 @@ let make_macro_api ctx mctx p =
 				| _ -> false
 			in
 			let add is_macro ctx =
-				let cc = CommonCache.get_cache ctx.com in
 				try
-					let m_extra = cc#find_module_extra mpath in
+					let m_extra = !TypeloadCacheHook.find_module_extra_hook ctx.com mpath in
 					let pos = { pfile = (Path.UniqueKey.lazy_path m_extra.m_file); pmin = 0; pmax = 0 } in
 					raise_typing_error_ext (make_error ~sub:[
 						make_error ~depth:1 (Custom "Previously defined here") pos
@@ -500,9 +499,8 @@ let make_macro_api ctx mctx p =
 			) usings in
 			let types = imports @ usings @ types in
 			let mpath = Ast.parse_path m in
-			let cc = CommonCache.get_cache ctx.com in
 			begin try
-				let m_extra = cc#find_module_extra mpath in
+				let m_extra = !TypeloadCacheHook.find_module_extra_hook ctx.com mpath in
 				if mpath != ctx.m.curmod.m_path then begin
 					let pos = { pfile = (Path.UniqueKey.lazy_path m_extra.m_file); pmin = 0; pmax = 0 } in
 					raise_typing_error_ext (make_error ~sub:[

src/typing/typeloadCacheHook.ml

@@ -10,6 +10,7 @@ type find_module_result =
 	| BinaryModule of HxbData.module_cache
 	| NoModule
 
+let find_module_extra_hook : (Common.context -> path -> module_def_extra) ref = ref (fun _ _ -> raise Not_found)
 let type_module_hook : (Common.context -> (typer_pass -> (unit -> unit) -> unit) -> path -> pos -> find_module_result) ref = ref (fun _ _ _ _ -> NoModule)
 
 let fake_modules = Hashtbl.create 0