[skip ci] [hxb] WIP: populate server cache through hxb

src/compiler/compilationCache.ml

@@ -23,9 +23,25 @@ type cached_native_lib = {
 	c_nl_files : (path,Ast.package) Hashtbl.t;
 }
 
-class context_cache (index : int) = object(self)
+(* TODO find a better place (and name?) to store this? *)
+type module_cache = {
+	mc_path : path;
+	mc_bytes : bytes;
+	mc_extra : module_def_extra;
+}
+
+let get_module_name_of_cfile file cfile = match cfile.c_module_name with
+	| None ->
+		let name = Path.module_name_of_file file in
+		cfile.c_module_name <- Some name;
+		name
+	| Some name ->
+		name
+
+class context_cache (index : int) (sign : string) = object(self)
 	val files : (Path.UniqueKey.t,cached_file) Hashtbl.t = Hashtbl.create 0
 	val modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
+	val binary_cache : (path,module_cache) Hashtbl.t = Hashtbl.create 0
 	val removed_files = Hashtbl.create 0
 	val mutable json = JNull
 	val mutable initialized = false
@@ -42,6 +58,7 @@ class context_cache (index : int) = object(self)
 		try
 			let f = Hashtbl.find files key in
 			Hashtbl.remove files key;
+			Hashtbl.remove binary_cache (f.c_package, get_module_name_of_cfile f.c_file_path f);
 			Hashtbl.replace removed_files key f.c_file_path
 		with Not_found -> ()
 
@@ -57,17 +74,40 @@ class context_cache (index : int) = object(self)
 	method find_module_opt path =
 		Hashtbl.find_opt modules path
 
-	method cache_module path value =
-		Hashtbl.replace modules path value
+	method cache_module path m =
+		Hashtbl.replace modules path m;
+		(* TODO move this somewhere else, factorize with generate.ml as much as possible *)
+		let anon_identification = new Tanon_identification.tanon_identification ([],"") in
+		let writer = new HxbWriter.hxb_writer anon_identification in
+		writer#write_module m;
+		let ch = IO.output_bytes() in
+		writer#export ch;
+		let bytes = IO.close_out ch in
+		Hashtbl.replace binary_cache path {
+			mc_path = path;
+			mc_bytes = bytes;
+			(* TODO warning, this m_extra will be updated from module cache *)
+			mc_extra = m.m_extra;
+			(* mc_extra = { m.m_extra with m_processed = 1 } *)
+		}
+
+	method clear_cache =
+		Hashtbl.clear modules
 
 	(* initialization *)
 
 	method is_initialized = initialized
 	method set_initialized value = initialized <- value
 
+	method get_sign = sign
 	method get_index = index
 	method get_files = files
 	method get_modules = modules
+
+	(* TODO rename all this to something that makes sense *)
+	method get_hxb path = Hashtbl.find_opt binary_cache path
+
+	(* TODO handle hxb cache there too *)
 	method get_removed_files = removed_files
 
 	method get_json = json
@@ -115,7 +155,7 @@ class cache = object(self)
 		try
 			Hashtbl.find contexts sign
 		with Not_found ->
-			let cache = new context_cache (Hashtbl.length contexts) in
+			let cache = new context_cache (Hashtbl.length contexts) sign in
 			context_list <- cache :: context_list;
 			Hashtbl.add contexts sign cache;
 			cache
@@ -267,11 +307,3 @@ type context_options =
 	| NormalContext
 	| MacroContext
 	| NormalAndMacroContext
-
-let get_module_name_of_cfile file cfile = match cfile.c_module_name with
-	| None ->
-		let name = Path.module_name_of_file file in
-		cfile.c_module_name <- Some name;
-		name
-	| Some name ->
-		name

src/compiler/generate.ml

@@ -21,12 +21,14 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 	end
 
-let export_hxb com root (m:TType.module_def) =
+let export_hxb root m =
+(* let export_hxb com root m = *)
 	match m.m_extra.m_kind with
 		| MCode | MMacro | MFake -> begin
 			(* Printf.eprintf "Export module %s\n" (s_type_path m.m_path); *)
 			let anon_identification = new tanon_identification ([],"") in
-			let writer = new HxbWriter.hxb_writer com anon_identification in
+			let writer = new HxbWriter.hxb_writer anon_identification in
+			(* let writer = new HxbWriter.hxb_writer com anon_identification in *)
 			writer#write_module m;
 			let ch = IO.output_bytes() in
 			writer#export ch;
@@ -72,7 +74,8 @@ let check_hxb_output com actx =
 				clean_files path;
 				let t = Timer.timer ["generate";"hxb"] in
 				Printf.eprintf "%d modules, %d types\n" (List.length com.modules) (List.length com.types);
-				List.iter (export_hxb com path) com.modules;
+				List.iter (export_hxb path) com.modules;
+				(* List.iter (export_hxb com path) com.modules; *)
 				t();
 			in
 

src/compiler/hxb/hxbReader.ml

@@ -12,15 +12,15 @@ let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
 class hxb_reader
-	(com : Common.context)
-	(file_ch : IO.input)
+	(* (com : Common.context) *)
+	(* (file_ch : IO.input) *)
 	(make_module : path -> string -> module_def)
 	(add_module : module_def -> unit)
 	(resolve_type : string list -> string -> string -> module_type)
 = object(self)
 
 	val mutable m = null_module
-	val mutable ch = file_ch
+	val mutable ch = IO.input_bytes Bytes.empty
 	val mutable string_pool = Array.make 0 ""
 	val mutable doc_pool = Array.make 0 ""
 
@@ -92,7 +92,7 @@ class hxb_reader
 	method read_from_string_pool pool =
 		let l = self#read_uleb128 in
 		try pool.(l) with e ->
-			Printf.eprintf "  Failed getting string #%d\n" l;
+			ServerMessage.debug_msg (Printf.sprintf "  Failed getting string #%d\n" l);
 			raise e
 
 	method read_string =
@@ -163,49 +163,66 @@ class hxb_reader
 
 	method read_class_ref =
 		let i = self#read_uleb128 in
-		classes.(i)
+		try classes.(i) with e ->
+			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading class ref %i\n" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_abstract_ref =
 		let i = self#read_uleb128 in
-		abstracts.(i)
+		try abstracts.(i) with e ->
+			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading abstract ref %i\n" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_enum_ref =
 		let i = self#read_uleb128 in
-		enums.(i)
+		try enums.(i) with e ->
+			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading enum ref %i\n" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_typedef_ref =
 		let i = self#read_uleb128 in
-		typedefs.(i)
+		try typedefs.(i) with e ->
+			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading typedef ref %i\n" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_anon_ref =
 		let i = self#read_uleb128 in
-		(* Printf.eprintf " Read anon ref %d of %d\n" i ((Array.length anons) - 1); *)
-		anons.(i)
+		try anons.(i) with e ->
+			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon ref %i\n" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_field_ref fields =
 		let name = self#read_string in
 		try PMap.find name fields with e ->
-			Printf.eprintf "[%s]  %s reading field %s\n" (s_type_path m.m_path) todo_error name;
-			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields "");
+			ServerMessage.debug_msg (Printf.sprintf "[%s]  %s reading field %s\n" (s_type_path m.m_path) todo_error name);
+			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
 			null_field
 
 	method read_enum_field_ref en =
 		let name = self#read_string in
 		try PMap.find name en.e_constrs with e ->
-			Printf.eprintf "  %s reading enum field ref for %s.%s\n" todo_error (s_type_path en.e_path) name;
-			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs "");
+			ServerMessage.debug_msg (Printf.sprintf "  %s reading enum field ref for %s.%s\n" todo_error (s_type_path en.e_path) name);
+			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
 			null_enum_field
 
 	method read_anon_field_ref =
 		match IO.read_byte ch with
 		| 0 ->
 			let index = self#read_uleb128 in
-			anon_fields.(index)
+			(try anon_fields.(index) with e ->
+				ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon field (0) ref %i\n" (s_type_path m.m_path) todo_error index);
+				raise e
+			)
 		| 1 ->
 			let index = self#read_uleb128 in
-			let cf = self#read_class_field true in
-			anon_fields.(index) <- cf;
-			cf
+			(try begin
+				let cf = self#read_class_field true in
+				anon_fields.(index) <- cf;
+				cf
+			end with e ->
+				ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon field (1) ref %i\n" (s_type_path m.m_path) todo_error index);
+				raise e
+			)
 		| _ ->
 			assert false
 
@@ -1055,8 +1072,8 @@ class hxb_reader
 			| 250 -> TIdent (self#read_string)
 
 			| i ->
-				Printf.eprintf "  [ERROR] Unhandled texpr %d at:\n" i;
-				MessageReporting.display_source_at com pos;
+				ServerMessage.debug_msg (Printf.sprintf "  [ERROR] Unhandled texpr %d at:\n" i);
+				(* MessageReporting.display_source_at com pos; *)
 				assert false
 		in
 
@@ -1098,8 +1115,13 @@ class hxb_reader
 		let meta = self#read_metadata in
 		let kind = self#read_field_kind in
 
-		let expr = self#read_option (fun () -> self#read_texpr) in
-		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
+		let expr = try
+			self#read_option (fun () -> self#read_texpr)
+		with e ->
+			print_endline (Printf.sprintf "Error reading field expr for %s" cf.cf_name);
+			raise e
+		in
+		(* let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in *)
 
 		let l = self#read_uleb128 in
 		for i = 0 to l - 1 do
@@ -1448,10 +1470,11 @@ class hxb_reader
 	method read_hhdr =
 		let path = self#read_path in
 		let file = self#read_string in
+		(* ServerMessage.debug_msg (Printf.sprintf "Read hxb module %s" (s_type_path path)); *)
 		anon_fields <- Array.make (self#read_uleb128) null_field;
 		make_module path file
 
-	method read (debug : bool) (p : pos) =
+	method read (file_ch : IO.input) (debug : bool) (p : pos) =
 		(* TODO: add magic & version to writer! *)
 		(* if (Bytes.to_string (IO.nread ch 3)) <> "hxb" then *)
 		(* 	raise (HxbFailure "magic"); *)
@@ -1524,5 +1547,6 @@ class hxb_reader
 			| _ ->
 				error ("Unexpected late chunk: " ^ (string_of_chunk_kind kind))
 		) chunks;
+		(* ServerMessage.debug_msg (Printf.sprintf "Done reading hxb module %s" (s_type_path m.m_path)); *)
 		m
 end

src/compiler/hxb/hxbWriter.ml

@@ -243,7 +243,7 @@ class chunk
 end
 
 class ['a] hxb_writer
-	(com : Common.context)
+	(* (com : Common.context) *)
 	(anon_id : Type.t Tanon_identification.tanon_identification)
 = object(self)
 
@@ -849,7 +849,7 @@ class ['a] hxb_writer
 		let rec loop e =
 			(try self#write_type_instance e.etype; with _ -> begin
 				Printf.eprintf "Error while writing type instance for:\n";
-				MessageReporting.display_source_at com e.epos;
+				(* MessageReporting.display_source_at com e.epos; *)
 			end);
 			self#write_pos e.epos;
 
@@ -1184,7 +1184,7 @@ class ['a] hxb_writer
 		(* 	Printf.eprintf " (1) Write class field %s\n" cf.cf_name; *)
 		(try self#write_type_instance cf.cf_type with e -> begin
 			Printf.eprintf "%s while writing type instance for field %s\n" todo_error cf.cf_name;
-			raise e
+			(* raise e *)
 		end);
 		chunk#write_i32 cf.cf_flags;
 		chunk#write_option cf.cf_doc self#write_documentation;
@@ -1192,8 +1192,8 @@ class ['a] hxb_writer
 		self#write_field_kind cf.cf_kind;
 		(try chunk#write_option cf.cf_expr self#write_texpr with e -> begin
 			Printf.eprintf "%s while writing expr for field %s\n" todo_error cf.cf_name;
-			MessageReporting.display_source_at com cf.cf_pos;
-			raise e
+			(* MessageReporting.display_source_at com cf.cf_pos; *)
+			(* raise e *)
 		end);
 		chunk#write_option cf.cf_expr_unoptimized self#write_texpr;
 		chunk#write_list cf.cf_overloads (fun f -> self#write_class_field_data f);

src/compiler/server.ml

@@ -220,6 +220,36 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
 	t();
 	dirs
 
+let find_or_restore_module (cc : context_cache) ctx path =
+	match cc#find_module_opt path with
+	| None ->
+		begin match cc#get_hxb path with
+		| None -> raise Not_found
+		| Some mc ->
+			let reader = TypeloadModule.get_reader ctx null_pos in
+
+			let m = try
+				reader#read (IO.input_bytes mc.mc_bytes) true null_pos
+			(* Avoid exception chain when loading module dependencies, and print stack *)
+			with | Exit -> raise Exit
+			| e ->
+				print_endline (Printf.sprintf "Error while reading module %s from hxb:\n%s" (s_type_path path) (Printexc.to_string e));
+				print_endline (Printexc.get_backtrace ());
+				raise Exit
+			in
+
+			ServerMessage.restore_hxb ctx.Typecore.com mc.mc_path;
+			assert (cc#get_sign = mc.mc_extra.m_sign);
+			assert (m.m_extra.m_sign = mc.mc_extra.m_sign);
+
+			(* TODO restore some things from m_extra? *)
+			(* m.m_extra.m_cache_state <- mc.mc_extra.m_cache_state; *)
+			m
+		end
+	| Some m ->
+		assert (cc#get_sign = m.m_extra.m_sign);
+		m
+
 (* Checks if module [m] can be reused from the cache and returns None in that case. Otherwise, returns
    [Some m'] where [m'] is the module responsible for [m] not being reusable. *)
 let check_module sctx ctx m p =
@@ -310,6 +340,7 @@ let check_module sctx ctx m p =
 		let check_dependencies () =
 			PMap.iter (fun _ (sign,mpath) ->
 				let m2 = (com.cs#get_context sign)#find_module mpath in
+				(* let m2 = find_or_restore_module (com.cs#get_context sign) ctx mpath in *)
 				match check m2 with
 				| None -> ()
 				| Some reason -> raise (Dirty (DependencyDirty(m2.m_path,reason)))
@@ -411,7 +442,9 @@ let add_modules sctx ctx m p =
 				TypeloadModule.ModuleLevel.add_module ctx m p;
 				PMap.iter (Hashtbl.replace com.resources) m.m_extra.m_binded_res;
 				PMap.iter (fun _ (sign,mpath) ->
-					let m2 = (com.cs#get_context sign)#find_module mpath in
+					(* let m2 = (com.cs#get_context sign)#find_module mpath in *)
+					let m2 = find_or_restore_module (com.cs#get_context sign) ctx mpath in
+					assert (m2.m_extra.m_sign == sign);
 					add_modules (tabs ^ "  ") m0 m2
 				) m.m_extra.m_deps
 			)
@@ -425,8 +458,10 @@ let type_module sctx (ctx:Typecore.typer) mpath p =
 	let t = Timer.timer ["server";"module cache"] in
 	let com = ctx.Typecore.com in
 	let cc = CommonCache.get_cache com in
+	(* let sign = Define.get_signature com.defines in *)
+	(* let cc = com.cs#get_context sign in *)
 	try
-		let m = cc#find_module mpath in
+		let m = find_or_restore_module cc ctx mpath in
 		let tcheck = Timer.timer ["server";"module cache";"check"] in
 		begin match check_module sctx ctx m p with
 		| None -> ()
@@ -467,8 +502,9 @@ let after_target_init sctx ctx =
 		()
 
 let after_compilation sctx ctx =
-	if not (has_error ctx) then
-		maybe_cache_context sctx ctx.com
+	(* if not (has_error ctx) then *)
+	(* 	maybe_cache_context sctx ctx.com *)
+	ServerCompilationContext.after_compilation sctx ctx.com (has_error ctx)
 
 let mk_length_prefixed_communication allow_nonblock chin chout =
 	let sin = Unix.descr_of_in_channel chin in

src/compiler/serverCompilationContext.ml

@@ -57,10 +57,15 @@ let reset sctx =
 	Hashtbl.clear Timer.htimers;
 	Helper.start_time := get_time()
 
-let maybe_cache_context sctx com =
-	if com.display.dms_full_typing && com.display.dms_populate_cache then begin
+let after_compilation sctx com has_error =
+	if has_error || not com.display.dms_full_typing || not com.display.dms_populate_cache then
+		CommonCache.clear_cache sctx.cs com
+	else begin
 		CommonCache.cache_context sctx.cs com;
 		ServerMessage.cached_modules com "" (List.length com.modules);
+
+		(* TEMP: Wipe server cache to force loading from hxb *)
+		CommonCache.clear_cache sctx.cs com;
 	end
 
 let ensure_macro_setup sctx =
@@ -71,4 +76,4 @@ let ensure_macro_setup sctx =
 
 let cleanup () = match !MacroContext.macro_interp_cache with
 	| Some interp -> EvalContext.GlobalState.cleanup interp
-	| None -> ()
+	| None -> ()

src/compiler/serverMessage.ml

@@ -4,6 +4,7 @@ open CompilationCache
 open Type
 
 type server_message_options = {
+	mutable print_debug : bool;
 	mutable print_compiler_stage : bool;
 	mutable print_added_directory : bool;
 	mutable print_found_directories : bool;
@@ -14,6 +15,7 @@ type server_message_options = {
 	mutable print_removed_directory : bool;
 	mutable print_reusing : bool;
 	mutable print_retyping : bool;
+	mutable print_hxb : bool;
 	mutable print_skipping_dep : bool;
 	mutable print_unchanged_content : bool;
 	mutable print_cached_modules : bool;
@@ -31,6 +33,7 @@ type server_message_options = {
 }
 
 let config = {
+	print_debug = false;
 	print_compiler_stage = false;
 	print_added_directory = false;
 	print_found_directories = false;
@@ -41,6 +44,7 @@ let config = {
 	print_removed_directory = false;
 	print_reusing = false;
 	print_retyping = false;
+	print_hxb = false;
 	print_skipping_dep = false;
 	print_unchanged_content = false;
 	print_cached_modules = false;
@@ -66,6 +70,9 @@ let sign_string com =
 let compiler_stage com =
 	if config.print_compiler_stage then print_endline (Printf.sprintf "compiler stage: %s" (s_compiler_stage com.stage))
 
+let debug_msg msg =
+	if config.print_debug then print_endline msg
+
 let added_directory com tabs dir =
 	if config.print_added_directory then print_endline (Printf.sprintf "%sadded directory %s" (sign_string com) dir)
 
@@ -91,6 +98,9 @@ let removed_directory com tabs dir =
 let reusing com tabs m =
 	if config.print_reusing then print_endline (Printf.sprintf "%s%sreusing %s" (sign_string com) tabs (s_type_path m.m_path))
 
+let restore_hxb com path =
+	if config.print_hxb then print_endline (Printf.sprintf "%srestoring %s from hxb" (sign_string com) (s_type_path path))
+
 let retyper_ok com tabs m =
 	if config.print_retyping then print_endline (Printf.sprintf "%s%sretyped %s" (sign_string com) tabs (s_type_path m.m_path))
 
@@ -143,16 +153,18 @@ let message s =
 	if config.print_message then print_endline ("> " ^ s)
 
 let gc_stats time stats_before did_compact space_overhead =
-	if config.print_stats then begin
-		let stats = Gc.quick_stat() in
-		print_endline (Printf.sprintf "GC %s done in %.2fs with space_overhead = %i\n\tbefore: %s\n\tafter: %s"
-			(if did_compact then "compaction" else "collection")
-			time
-			space_overhead
-			(Memory.fmt_word (float_of_int stats_before.Gc.heap_words))
-			(Memory.fmt_word (float_of_int stats.heap_words))
-		)
-	end
+	(* Commented out to avoid dependency cycle with hxb.. *)
+	()
+	(* if config.print_stats then begin *)
+	(* 	let stats = Gc.quick_stat() in *)
+	(* 	print_endline (Printf.sprintf "GC %s done in %.2fs with space_overhead = %i\n\tbefore: %s\n\tafter: %s" *)
+	(* 		(if did_compact then "compaction" else "collection") *)
+	(* 		time *)
+	(* 		space_overhead *)
+	(* 		(Memory.fmt_word (float_of_int stats_before.Gc.heap_words)) *)
+	(* 		(Memory.fmt_word (float_of_int stats.heap_words)) *)
+	(* 	) *)
+	(* end *)
 
 let socket_message s =
 	if config.print_socket_message then print_endline s
@@ -161,6 +173,7 @@ let uncaught_error s =
 	if config.print_uncaught_error then print_endline ("Uncaught Error : " ^ s)
 
 let enable_all () =
+	config.print_debug <- true;
 	config.print_compiler_stage <- true;
 	config.print_added_directory <- true;
 	config.print_found_directories <- true;
@@ -171,6 +184,7 @@ let enable_all () =
 	config.print_removed_directory <- true;
 	config.print_reusing <- true;
 	config.print_retyping <- true;
+	config.print_hxb <- true;
 	config.print_skipping_dep <- true;
 	config.print_unchanged_content <- true;
 	config.print_cached_modules <- true;
@@ -187,6 +201,7 @@ let enable_all () =
 
 let set_by_name name value = match name with
 	| "compilerStage" -> config.print_compiler_stage <- value
+	| "debug" -> config.print_debug <- value
 	| "addedDirectory" -> config.print_added_directory <- value
 	| "foundDirectories" -> config.print_found_directories <- value;
 	| "changedDirectories" -> config.print_changed_directories <- value;
@@ -196,6 +211,7 @@ let set_by_name name value = match name with
 	| "removedDirectory" -> config.print_removed_directory <- value;
 	| "reusing" -> config.print_reusing <- value;
 	| "retyping" -> config.print_retyping <- value;
+	| "hxb" -> config.print_hxb <- value;
 	| "skippingDep" -> config.print_skipping_dep <- value;
 	| "unchangedContent" -> config.print_unchanged_content <- value;
 	| "cachedModules" -> config.print_cached_modules <- value;

src/context/commonCache.ml

@@ -75,6 +75,7 @@ let rec cache_context cs com =
 	let cache_module m =
 		(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heueristic. *)
 		let cc = if m.m_extra.m_sign == sign then cc else cs#get_context m.m_extra.m_sign in
+		(* assert (m.m_extra.m_sign = sign); *)
 		cc#cache_module m.m_path m;
 	in
 	List.iter cache_module com.modules;
@@ -82,6 +83,19 @@ let rec cache_context cs com =
 	| None -> ()
 	| Some com -> cache_context cs com
 
+let rec clear_cache cs com =
+	let cc = get_cache com in
+	cc#clear_cache;
+
+	com.module_lut#clear;
+	com.stored_typed_exprs#clear;
+	com.module_nonexistent_lut#clear;
+	(* com.type_to_module#clear; *)
+
+	match com.get_macros() with
+	| None -> ()
+	| Some com -> clear_cache cs com
+
 let maybe_add_context_sign cs com desc =
 	let sign = Define.get_signature com.defines in
 	ignore(cs#add_info sign desc com.platform com.class_path com.defines)
@@ -89,4 +103,4 @@ let maybe_add_context_sign cs com desc =
 let lock_signature com name =
 	let cs = com.cs in
 	maybe_add_context_sign cs com name;
-	com.cache <- Some (get_cache com)
+	com.cache <- Some (get_cache com)

src/core/define.ml

@@ -123,6 +123,7 @@ let get_signature def =
 			| _ -> (k ^ "=" ^ v) :: acc
 		) def.values [] in
 		let str = String.concat "@" (List.sort compare defines) in
+		(* Printf.eprintf "Defines: %s\n" str; *)
 		let s = Digest.string str in
 		def.defines_signature <- Some s;
 		s

src/core/tType.ml

@@ -371,7 +371,7 @@ and module_def = {
 	m_path : path;
 	mutable m_types : module_type list;
 	mutable m_statics : tclass option;
-	m_extra : module_def_extra;
+	mutable m_extra : module_def_extra;
 }
 
 and module_def_display = {

src/typing/typeloadCheck.ml

@@ -324,7 +324,9 @@ let check_module_types ctx m p t =
 		let hex1 = Digest.to_hex m.m_extra.m_sign in
 		let hex2 = Digest.to_hex m2.m_extra.m_sign in
 		let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in
-		raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p
+		(* raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p *)
+		(* ctx.com.warning WInfo [] (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p; *)
+		print_endline (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s);
 	with
 		Not_found ->
 			ctx.com.type_to_module#add t.mt_path m.m_path

src/typing/typeloadModule.ml

@@ -44,7 +44,7 @@ let field_of_static_definition d p =
 	}
 
 module ModuleLevel = struct
-	let make_module ctx mpath file loadp =
+	let make_module ctx mpath file =
 		let m = {
 			m_id = alloc_mid();
 			m_path = mpath;
@@ -293,7 +293,7 @@ module ModuleLevel = struct
 		let make_import_module path r =
 			com.parser_cache#add path r;
 			(* We use the file path as module name to make it unique. This may or may not be a good idea... *)
-			let m_import = make_module ctx ([],path) path p in
+			let m_import = make_module ctx ([],path) path in
 			m_import.m_extra.m_kind <- MImport;
 			m_import
 		in
@@ -784,7 +784,7 @@ let type_types_into_module ctx m tdecls p =
 	Creates a new module and types [tdecls] into it.
 *)
 let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p =
-	let m = ModuleLevel.make_module ctx mpath file p in
+	let m = ModuleLevel.make_module ctx mpath file in
 	ctx.com.module_lut#add m.m_path m;
 	let tdecls = ModuleLevel.handle_import_hx ctx m tdecls p in
 	let ctx = type_types_into_module ctx m tdecls p in
@@ -797,9 +797,11 @@ let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecl
 
 let type_module_hook = ref (fun _ _ _ -> None)
 
-let rec get_reader ctx input mpath p =
+(* TODO: get rid of `p` here? *)
+let rec get_reader ctx p =
 	let make_module path file =
-		let m = ModuleLevel.make_module ctx path file p in
+		let m = ModuleLevel.make_module ctx path file in
+		(* m.m_extra.m_added <- ctx.com.compilation_step; *)
 		m.m_extra.m_processed <- 1;
 		m
 	in
@@ -813,7 +815,7 @@ let rec get_reader ctx input mpath p =
 		List.find (fun t -> snd (t_path t) = tname) m.m_types
 	in
 
-	new HxbReader.hxb_reader ctx.com input make_module add_module resolve_type
+	new HxbReader.hxb_reader make_module add_module resolve_type
 
 and load_hxb_module ctx path p =
 	let compose_path no_rename =
@@ -834,7 +836,7 @@ and load_hxb_module ctx path p =
 	(* TODO use finally instead *)
 	try
 		(* Printf.eprintf "[%s] Read module %s\n" target (s_type_path path); *)
-		let m = (get_reader ctx input path p)#read true p in
+		let m = (get_reader ctx p)#read input true p in
 		(* Printf.eprintf "[%s] Done reading module %s\n" target (s_type_path path); *)
 		close_in ch;
 		m