[hxb] restore without typing

src/compiler/compilationCache.ml

@@ -23,13 +23,6 @@ type cached_native_lib = {
 	c_nl_files : (path,Ast.package) Hashtbl.t;
 }
 
-(* 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
@@ -58,7 +51,6 @@ class context_cache (index : int) (sign : string) = 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 -> ()
 
@@ -86,9 +78,7 @@ class context_cache (index : int) (sign : string) = object(self)
 		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 } *)
+			mc_extra = { m.m_extra with m_cache_state = MSGood }
 		}
 
 	method clear_cache =
@@ -105,7 +95,8 @@ class context_cache (index : int) (sign : string) = object(self)
 	method get_modules = modules
 
 	(* TODO rename all this to something that makes sense *)
-	method get_hxb path = Hashtbl.find_opt binary_cache path
+	method get_hxb = binary_cache
+	method get_hxb_module path = Hashtbl.find_opt binary_cache path
 
 	(* TODO handle hxb cache there too *)
 	method get_removed_files = removed_files
@@ -213,8 +204,9 @@ class cache = object(self)
 	method taint_modules file_key reason =
 		Hashtbl.iter (fun _ cc ->
 			Hashtbl.iter (fun _ m ->
-				if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_cache_state <- MSBad (Tainted reason)
-			) cc#get_modules
+				if Path.UniqueKey.lazy_key m.mc_extra.m_file = file_key then m.mc_extra.m_cache_state <- MSBad (Tainted reason)
+			) cc#get_hxb
+			(* ) cc#get_modules *)
 		) contexts
 
 	(* haxelibs *)

src/compiler/hxb/hxbReader.ml

@@ -24,6 +24,7 @@ class hxb_reader
 	(make_module : path -> string -> module_def)
 	(add_module : module_def -> unit)
 	(resolve_type : string list -> string -> string -> module_type)
+	(flush_fields : unit -> unit)
 = object(self)
 
 	val mutable m = null_module
@@ -1538,6 +1539,7 @@ class hxb_reader
 			| CLSD ->
 				self#read_clsd;
 			| CFLD ->
+				flush_fields ();
 				self#read_cfld;
 			| ENMD ->
 				self#read_enmd;

src/compiler/hxb/hxbRestore.ml

@@ -0,0 +1,51 @@
+open Globals
+open Type
+
+class hxb_restore
+	(cc : CompilationCache.context_cache)
+	(com : Common.context)
+= object(self)
+
+	method find (path : path) =
+		try com.module_lut#find path with
+		| Not_found ->
+			match cc#find_module_opt path with
+			| Some m -> m
+			| None ->
+					begin match cc#get_hxb_module path with
+						| None -> raise Not_found
+						| Some mc -> self#load mc
+					end
+
+	method load (mc : module_cache) =
+		(* print_endline (Printf.sprintf "[1] Load %s from hxb" (s_type_path mc.mc_path)); *)
+		let reader = new HxbReader.hxb_reader (self#make_module mc) self#add_module self#resolve_type (fun () -> ()) in
+		reader#read (IO.input_bytes mc.mc_bytes) true null_pos
+
+	method add_module (m : module_def) =
+		com.module_lut#add m.m_path m
+
+	method resolve_type (pack : string list) (mname : string) (tname : string) =
+		let path = (pack,mname) in
+		let m = self#find path in
+		List.find (fun t -> snd (t_path t) = tname) m.m_types
+
+	method make_module (mc : module_cache) (path : path) (file : string) =
+		{
+			m_id = alloc_mid();
+			m_path = path;
+			m_types = [];
+			m_statics = None;
+			m_extra = { mc.mc_extra with
+				m_added = 1;
+				m_checked = 0;
+				m_processed = 1;
+				m_time = (Common.file_time file)
+			}
+		}
+
+end
+
+let find (cc : CompilationCache.context_cache) (com : Common.context) (path : path) =
+	let loader = new hxb_restore cc com in
+	loader#find path

src/compiler/server.ml

@@ -221,34 +221,7 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
 	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
+	HxbRestore.find cc ctx.Typecore.com path
 
 (* 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. *)
@@ -339,8 +312,7 @@ let check_module sctx ctx m p =
 		in
 		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 *)
+				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)))
@@ -442,7 +414,6 @@ 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 = find_or_restore_module (com.cs#get_context sign) ctx mpath in
 					assert (m2.m_extra.m_sign == sign);
 					add_modules (tabs ^ "  ") m0 m2
@@ -458,8 +429,6 @@ 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 = find_or_restore_module cc ctx mpath in
 		let tcheck = Timer.timer ["server";"module cache";"check"] in

src/context/display/displayJson.ml

@@ -185,7 +185,7 @@ let handler =
 			let cs = hctx.display#get_cs in
 			let cc = cs#get_context sign in
 			let m = try
-				cc#find_module path
+				HxbRestore.find cc hctx.com path
 			with Not_found ->
 				hctx.send_error [jstring "No such module"]
 			in
@@ -197,7 +197,7 @@ let handler =
 			let typeName = hctx.jsonrpc#get_string_param "typeName" in
 			let cc = hctx.display#get_cs#get_context sign in
 			let m = try
-				cc#find_module path
+				HxbRestore.find cc hctx.com path
 			with Not_found ->
 				hctx.send_error [jstring "No such module"]
 			in

src/core/tType.ml

@@ -366,14 +366,6 @@ and module_type =
 	| TTypeDecl of tdef
 	| TAbstractDecl of tabstract
 
-and module_def = {
-	m_id : int;
-	m_path : path;
-	mutable m_types : module_type list;
-	mutable m_statics : tclass option;
-	mutable m_extra : module_def_extra;
-}
-
 and module_def_display = {
 	mutable m_inline_calls : (pos * pos) list; (* calls whatever is at pos1 from pos2 *)
 	mutable m_type_hints : (pos * pos) list;
@@ -417,6 +409,20 @@ and module_kind =
 	| MExtern
 	| MImport
 
+and module_def = {
+	m_id : int;
+	m_path : path;
+	mutable m_types : module_type list;
+	mutable m_statics : tclass option;
+	mutable m_extra : module_def_extra;
+}
+
+and module_cache = {
+	mc_path : path;
+	mc_bytes : bytes;
+	mc_extra : module_def_extra;
+}
+
 and build_state =
 	| Built
 	| Building of tclass list

src/typing/typeloadModule.ml

@@ -797,8 +797,10 @@ let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecl
 
 let type_module_hook = ref (fun _ _ _ -> None)
 
-(* TODO: get rid of `p` here? *)
-let rec get_reader ctx p =
+let rec get_reader ctx =
+	(* TODO: create typer context for this module? *)
+	(* let ctx = create_typer_context_for_module tctx m in *)
+
 	let make_module path file =
 		let m = ModuleLevel.make_module ctx path file in
 		(* m.m_extra.m_added <- ctx.com.compilation_step; *)
@@ -810,12 +812,17 @@ let rec get_reader ctx p =
 		ctx.com.module_lut#add m.m_path m
 	in
 
+	let flush_fields () =
+		flush_pass ctx PConnectField "hxb"
+	in
+
 	let resolve_type pack mname tname =
-		let m = try ctx.com.module_lut#find (pack,mname) with Not_found -> load_module' ctx ctx.g (pack,mname) p in
+		let cc = CommonCache.get_cache ctx.Typecore.com in
+		let m = HxbRestore.find cc ctx.Typecore.com (pack,mname) in
 		List.find (fun t -> snd (t_path t) = tname) m.m_types
 	in
 
-	new HxbReader.hxb_reader make_module add_module resolve_type
+	new HxbReader.hxb_reader make_module add_module resolve_type flush_fields
 
 and load_hxb_module ctx path p =
 	let compose_path no_rename =
@@ -836,7 +843,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 p)#read input true p in
+		let m = (get_reader ctx)#read input true p in
 		(* Printf.eprintf "[%s] Done reading module %s\n" target (s_type_path path); *)
 		close_in ch;
 		m