Compilation server reorganization (#8707)

* [server] add `context_cache` and reorganize server structure

see #8667

* [server] cache cache reference in context

* [server] cleanup

* [server] avoid per-module cache lookups when caching, if we can

* [server] also cache macro and core-class caches

* [server] merge signature handling into context_cache

* [server] merge initialization status too

src/codegen/dotnet.ml

@@ -1222,7 +1222,7 @@ let add_net_lib com file std extern =
 	let net_lib = new net_library com file real_file std in
 	if extern then net_lib#add_flag FlagIsExtern;
 	com.native_libs.net_libs <- (net_lib :> (net_lib_type,unit) native_library) :: com.native_libs.net_libs;
-	CompilationServer.handle_native_lib com net_lib
+	CommonCache.handle_native_lib com net_lib
 
 let before_generate com =
 	(* netcore version *)

src/codegen/java.ml

@@ -1205,7 +1205,7 @@ let add_java_lib com name std extern =
 	if std then java_lib#add_flag FlagIsStd;
 	if extern then java_lib#add_flag FlagIsExtern;
 	com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs;
-	CompilationServer.handle_native_lib com java_lib
+	CommonCache.handle_native_lib com java_lib
 
 let before_generate con =
 	let java_ver = try

src/codegen/swfLoader.ml

@@ -626,7 +626,7 @@ let add_swf_lib com file extern =
 	let real_file = (try Common.find_file com file with Not_found -> failwith (" Library not found : " ^ file)) in
 	let swf_lib = new swf_library com file real_file in
 	if not extern then com.native_libs.swf_libs <- (swf_lib :> (swf_lib_type,Swf.swf) native_library) :: com.native_libs.swf_libs;
-	CompilationServer.handle_native_lib com swf_lib
+	CommonCache.handle_native_lib com swf_lib
 
 let remove_classes toremove lib l =
 	match !toremove with

src/compiler/displayOutput.ml

@@ -229,7 +229,8 @@ module Memory = struct
 		Obj.repr Common.memory_marker :: PMap.fold (fun m acc -> Obj.repr m :: acc) out []
 
 	let collect_memory_stats cs =
-		let all_modules = Hashtbl.fold (fun _ m acc -> PMap.add m.m_id m acc) cs.c_modules PMap.empty in
+		[]
+		(* let all_modules = Hashtbl.fold (fun _ m acc -> PMap.add m.m_id m acc) cs.c_modules PMap.empty in
 		let modules = Hashtbl.fold (fun (path,key) m acc ->
 			let mdeps = Hashtbl.create 0 in
 			scan_module_deps m mdeps;
@@ -249,7 +250,7 @@ module Memory = struct
 			let leaks = if inf.reached then collect_leaks m deps out else [] in
 			(m,Objsize.size_with_headers inf, (inf.reached,deps,out,leaks)) :: acc
 		) cs.c_modules [] in
-		modules
+		modules *)
 
 	let fmt_size sz =
 		if sz < 1024 then
@@ -263,7 +264,8 @@ module Memory = struct
 		fmt_size (mem_size v)
 
 	let get_memory_json cs =
-		Gc.full_major();
+		jnull
+		(* Gc.full_major();
 		Gc.compact();
 		let contexts = Hashtbl.create 0 in
 		let add_context sign =
@@ -385,7 +387,7 @@ module Memory = struct
 				"macroInterpreter",jint (mem_size MacroContext.macro_interp_cache);
 				"completionResult",jint (mem_size (DisplayException.last_completion_result));
 			]
-		]
+		] *)
 
 	let display_memory com =
 		let verbose = com.verbose in
@@ -401,8 +403,8 @@ module Memory = struct
 		| Some {cache = c} ->
 			print ("Total cache size " ^ size c);
 			print ("  haxelib " ^ size c.c_haxelib);
-			print ("  parsed ast " ^ size c.c_files ^ " (" ^ string_of_int (Hashtbl.length c.c_files) ^ " files stored)");
-			print ("  typed modules " ^ size c.c_modules ^ " (" ^ string_of_int (Hashtbl.length c.c_modules) ^ " modules stored)");
+			(* print ("  parsed ast " ^ size c.c_files ^ " (" ^ string_of_int (Hashtbl.length c.c_files) ^ " files stored)"); *)
+			(* print ("  typed modules " ^ size c.c_modules ^ " (" ^ string_of_int (Hashtbl.length c.c_modules) ^ " modules stored)"); *)
 			let modules = collect_memory_stats c in
 			let cur_key = ref "" and tcount = ref 0 and mcount = ref 0 in
 			List.iter (fun (m,size,(reached,deps,out,leaks)) ->

src/compiler/main.ml

@@ -496,12 +496,13 @@ let do_type tctx config_macros classes =
 	let com = tctx.Typecore.com in
 	let t = Timer.timer ["typing"] in
 	let add_signature desc =
-		Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com desc) (CompilationServer.get ());
+		Option.may (fun cs -> CommonCache.maybe_add_context_sign cs com desc) (CompilationServer.get ());
 	in
 	add_signature "before_init_macros";
 	com.stage <- CInitMacrosStart;
 	List.iter (MacroContext.call_init_macro tctx) (List.rev config_macros);
 	com.stage <- CInitMacrosDone;
+	com.cache <- (match CompilationServer.get() with None -> None | Some cs -> Some (CommonCache.get_cache cs com));
 	add_signature "after_init_macros";
 	List.iter (fun f -> f ()) (List.rev com.callbacks#get_after_init_macros);
 	run_or_diagnose com (fun () ->

src/compiler/server.ml

@@ -131,18 +131,17 @@ let ssend sock str =
 let current_stdin = ref None
 
 let parse_file cs com file p =
+	let cc = CommonCache.get_cache cs com in
 	let ffile = Path.unique_full_path file in
 	let is_display_file = ffile = (DisplayPosition.display_position#get).pfile in
 	match is_display_file, !current_stdin with
 	| true, Some stdin when Common.defined com Define.DisplayStdin ->
 		TypeloadParse.parse_file_from_string com file p stdin
 	| _ ->
-		let sign = Define.get_signature com.defines in
 		let ftime = file_time ffile in
-		let fkey = (ffile,sign) in
 		let data = Std.finally (Timer.timer ["server";"parser cache"]) (fun () ->
 			try
-				let cfile = CompilationServer.find_file cs fkey in
+				let cfile = CompilationServer.find_file cc ffile in
 				if cfile.c_time <> ftime then raise Not_found;
 				Parser.ParseSuccess(cfile.c_package,cfile.c_decls)
 			with Not_found ->
@@ -158,7 +157,7 @@ let parse_file cs com file p =
 							let ident = Hashtbl.find Parser.special_identifier_files ffile in
 							Printf.sprintf "not cached, using \"%s\" define" ident,true
 						with Not_found ->
-							CompilationServer.cache_file cs fkey ftime data;
+							CompilationServer.cache_file cc ffile ftime data;
 							"cached",false
 						end
 				in
@@ -186,7 +185,7 @@ module ServerCompilationContext = struct
 		(* A list of delays which are run after compilation *)
 		mutable delays : (unit -> unit) list;
 		(* A list of modules which were (perhaps temporarily) removed from the cache *)
-		mutable removed_modules : ((path * string) * module_def) list;
+		mutable removed_modules : (context_cache * path * module_def) list;
 		(* True if it's an actual compilation, false if it's a display operation *)
 		mutable was_compilation : bool;
 	}
@@ -213,7 +212,7 @@ module ServerCompilationContext = struct
 		List.iter (fun f -> f()) fl
 
 	let is_removed_module sctx m =
-		List.exists (fun (_,m') -> m == m') sctx.removed_modules
+		List.exists (fun (_,_,m') -> m == m') sctx.removed_modules
 
 	let reset sctx =
 		Hashtbl.clear sctx.changed_directories;
@@ -294,13 +293,11 @@ let get_changed_directories sctx (ctx : Typecore.typer) =
    [Some m'] where [m'] is the module responsible for [m] not being reusable. *)
 let check_module sctx ctx m p =
 	let com = ctx.Typecore.com in
-	let cs = sctx.cs in
-	let sign = Define.get_signature com.defines in
+	let cc = CommonCache.get_cache sctx.cs com in
 	let content_changed m file =
 		let ffile = Path.unique_full_path file in
-		let fkey = (ffile,sign) in
 		try
-			let cfile = CompilationServer.find_file cs fkey in
+			let cfile = CompilationServer.find_file cc ffile in
 			(* We must use the module path here because the file path is absolute and would cause
 				positions in the parsed declarations to differ. *)
 			let new_data = TypeloadParse.parse_module ctx m.m_path p in
@@ -455,11 +452,10 @@ let add_modules sctx ctx m p =
 let type_module sctx (ctx:Typecore.typer) mpath p =
 	let t = Timer.timer ["server";"module cache"] in
 	let com = ctx.Typecore.com in
-	let cs = sctx.cs in
-	let sign = Define.get_signature com.defines in
+	let cc = CommonCache.get_cache sctx.cs com in
 	sctx.mark_loop <- sctx.mark_loop + 1;
 	try
-		let m = CompilationServer.find_module cs (mpath,sign) in
+		let m = CompilationServer.find_module cc mpath in
 		let tcheck = Timer.timer ["server";"module cache";"check"] in
 		begin match check_module sctx ctx m p with
 		| None -> ()
@@ -482,17 +478,17 @@ let type_module sctx (ctx:Typecore.typer) mpath p =
 let create sctx write params =
 	let cs = sctx.cs in
 	let recache_removed_modules () =
-		List.iter (fun (k,m) ->
+		List.iter (fun (cc,k,m) ->
 			try
-				ignore(CompilationServer.find_module sctx.cs k);
+				ignore(CompilationServer.find_module cc k);
 			with Not_found ->
-				CompilationServer.cache_module sctx.cs k m
+				CompilationServer.cache_module cc k m
 		) sctx.removed_modules;
 		sctx.removed_modules <- []
 	in
 	let maybe_cache_context com =
 		if com.display.dms_full_typing then begin
-			CompilationServer.cache_context sctx.cs com;
+			CommonCache.cache_context sctx.cs com;
 			ServerMessage.cached_modules com "" (List.length com.modules);
 			sctx.removed_modules <- [];
 		end else
@@ -536,7 +532,7 @@ let create sctx write params =
 				ServerMessage.class_paths_changed ctx.com "";
 				Hashtbl.replace sctx.class_paths sign ctx.com.class_path;
 				CompilationServer.clear_directories cs sign;
-				CompilationServer.set_initialized cs sign false;
+				(CompilationServer.get_cache cs sign).c_initialized <- false;
 			end;
 		with Not_found ->
 			Hashtbl.add sctx.class_paths sign ctx.com.class_path;

src/compiler/serverMessage.ml

@@ -57,14 +57,7 @@ let config = {
 let sign_string com =
 	let sign = Define.get_signature com.defines in
 	let cs = CompilationServer.force () in
-	let	sign_id =
-		try
-			(CompilationServer.get_sign cs sign).cs_index
-		with Not_found ->
-			let i = CompilationServer.add_sign cs sign "message" com in
-			if config.print_new_context then print_endline (Printf.sprintf "Found context %i:\n%s" i (dump_context com));
-			i
-	in
+	let	sign_id = (CompilationServer.get_cache cs sign).c_index in
 	Printf.sprintf "%2i,%3s: " sign_id (short_platform_name com.platform)
 
 let added_directory com tabs dir =

src/context/common.ml

@@ -18,6 +18,7 @@
  *)
 
 open Ast
+open CompilationServer
 open Type
 open Globals
 open Define
@@ -194,6 +195,7 @@ type compiler_stage =
 
 type context = {
 	mutable stage : compiler_stage;
+	mutable cache : context_cache option;
 	(* config *)
 	version : int;
 	args : string list;
@@ -435,6 +437,7 @@ let create version s_version args =
 		)
 	in
 	{
+		cache = None;
 		stage = CCreated;
 		version = version;
 		args = args;
@@ -515,6 +518,7 @@ let log com str =
 let clone com =
 	let t = com.basic in
 	{ com with
+		cache = None;
 		basic = { t with tvoid = t.tvoid };
 		main_class = None;
 		features = Hashtbl.create 0;

src/context/commonCache.ml

@@ -0,0 +1,86 @@
+open Globals
+open Common
+open CompilationServer
+open Type
+
+(* native lib *)
+
+let add_native_lib cs key files timestamp =
+	Hashtbl.replace cs.cache.c_native_libs key { c_nl_files = files; c_nl_mtime = timestamp }
+
+let get_native_lib cs key =
+	try Some (Hashtbl.find cs.cache.c_native_libs key)
+	with Not_found -> None
+
+let handle_native_lib com lib =
+	com.native_libs.all_libs <- lib#get_file_path :: com.native_libs.all_libs;
+	com.load_extern_type <- com.load_extern_type @ [lib#get_file_path,lib#build];
+	match get() with
+	| Some cs when not (Define.raw_defined com.defines "haxe.noNativeLibsCache") ->
+		let init () =
+			let file = lib#get_file_path in
+			let key = file in
+			let ftime = file_time file in
+			begin match get_native_lib cs key with
+			| Some lib when ftime <= lib.c_nl_mtime ->
+				(* Cached lib is good, set up lookup into cached files. *)
+				lib.c_nl_files;
+			| _ ->
+				(* Cached lib is outdated or doesn't exist yet, read library. *)
+				lib#load;
+				(* Created lookup and eagerly read each known type. *)
+				let h = Hashtbl.create 0 in
+				List.iter (fun path ->
+					if not (Hashtbl.mem h path) then begin
+						let p = { pfile = file ^ " @ " ^ Globals.s_type_path path; pmin = 0; pmax = 0; } in
+						try begin match lib#build path p with
+						| Some r -> Hashtbl.add h path r
+						| None -> ()
+						end with _ ->
+							()
+					end
+				) lib#list_modules;
+				(* Save and set up lookup. *)
+				add_native_lib cs key h ftime;
+				h;
+			end;
+		in
+		(fun () ->
+			let lut = init() in
+			let build path p =
+				try Some (Hashtbl.find lut path)
+				with Not_found -> None
+			in
+			com.load_extern_type <- List.map (fun (name,f) ->
+				name,if name = lib#get_file_path then build else f
+			) com.load_extern_type
+		)
+	| _ ->
+		(* Offline mode, just read library as usual. *)
+		(fun () -> lib#load)
+
+(* context *)
+
+let get_cache cs com = match com.Common.cache with
+	| None ->
+		let sign = Define.get_signature com.defines in
+		CompilationServer.get_cache cs sign
+	| Some cache ->
+		cache
+
+let rec cache_context cs com =
+	let cc = get_cache cs com in
+	let sign = Define.get_signature com.defines in
+	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 CompilationServer.get_cache cs m.m_extra.m_sign in
+		cache_module cc m.m_path m;
+	in
+	List.iter cache_module com.modules;
+	match com.get_macros() with
+	| None -> ()
+	| Some com -> cache_context cs com
+
+let maybe_add_context_sign cs com desc =
+	let sign = Define.get_signature com.defines in
+	ignore(add_info cs sign desc com.platform com.class_path com.defines)

src/context/compilationServer.ml

@@ -2,7 +2,7 @@ open Globals
 open Ast
 open Json
 open Type
-open Common
+open Define
 
 type cached_file = {
 	c_time : float;
@@ -21,24 +21,24 @@ type cached_native_lib = {
 	c_nl_files : (path,Ast.package) Hashtbl.t;
 }
 
+type context_cache = {
+	c_files : (string,cached_file) Hashtbl.t;
+	c_modules : (path,module_def) Hashtbl.t;
+	c_removed_files : (string,unit) Hashtbl.t;
+	c_index : int;
+	mutable c_json : Json.t;
+	mutable c_initialized : bool;
+}
+
 type cache = {
+	c_contexts : (string,context_cache) Hashtbl.t;
 	c_haxelib : (string list, string list) Hashtbl.t;
-	c_files : ((string * string), cached_file) Hashtbl.t;
-	c_modules : (path * string, module_def) Hashtbl.t;
 	c_directories : (string, cached_directory list) Hashtbl.t;
-	c_removed_files : (string * string,unit) Hashtbl.t;
 	c_native_libs : (string,cached_native_lib) Hashtbl.t;
-	c_initialization_status : (string,bool) Hashtbl.t;
-}
-
-type context_sign = {
-	cs_json : Json.t;
-	cs_index : int;
 }
 
 type t = {
 	cache : cache;
-	mutable signs : (string * context_sign) list;
 }
 
 type context_options =
@@ -50,18 +50,23 @@ let instance : t option ref = ref None
 
 let create_cache () = {
 	c_haxelib = Hashtbl.create 0;
-	c_files = Hashtbl.create 0;
-	c_modules = Hashtbl.create 0;
+	c_contexts = Hashtbl.create 0;
 	c_directories = Hashtbl.create 0;
-	c_removed_files = Hashtbl.create 0;
 	c_native_libs = Hashtbl.create 0;
-	c_initialization_status = Hashtbl.create 0;
+}
+
+let create_context_cache index = {
+	c_modules = Hashtbl.create 0;
+	c_files = Hashtbl.create 0;
+	c_removed_files = Hashtbl.create 0;
+	c_index = index;
+	c_json = JNull;
+	c_initialized = false;
 }
 
 let create () =
 	let cs = {
 		cache = create_cache();
-		signs = [];
 	} in
 	instance := Some cs;
 	cs
@@ -74,105 +79,87 @@ let runs () =
 
 let force () = match !instance with None -> assert false | Some i -> i
 
-let is_initialized cs sign =
-	try Hashtbl.find cs.cache.c_initialization_status sign with Not_found -> false
-
-let set_initialized cs sign value =
-	Hashtbl.replace cs.cache.c_initialization_status sign value
-
 let get_context_files cs signs =
-	Hashtbl.fold (fun (file,sign) cfile acc ->
-		if (List.mem sign signs) then (file,cfile) :: acc
+	Hashtbl.fold (fun sign cc acc ->
+		if List.mem sign signs then Hashtbl.fold (fun file cfile acc -> (file,cfile) :: acc) cc.c_files acc
 		else acc
-	) cs.cache.c_files []
+	) cs.cache.c_contexts []
 
 (* signatures *)
 
-let get_sign cs sign =
-	List.assoc sign cs.signs
-
-let has_sign cs sign =
-	List.mem_assoc sign cs.signs
+let get_cache cs sign =
+	try
+		Hashtbl.find cs.cache.c_contexts sign
+	with Not_found ->
+		let cache = create_context_cache (Hashtbl.length cs.cache.c_contexts) in
+		Hashtbl.add cs.cache.c_contexts sign cache;
+		cache
 
-let add_sign cs sign desc com =
-	let i = List.length cs.signs in
+let add_info cs sign desc platform class_path defines =
+	let cc = get_cache cs sign in
 	let jo = JObject [
-		"index",JInt i;
+		"index",JInt cc.c_index;
 		"desc",JString desc;
-		"platform",JString (platform_name com.platform);
-		"classPaths",JArray (List.map (fun s -> JString s) com.class_path);
+		"platform",JString (platform_name platform);
+		"classPaths",JArray (List.map (fun s -> JString s) class_path);
 		"signature",JString (Digest.to_hex sign);
 		"defines",JArray (PMap.foldi (fun k v acc -> JObject [
 			"key",JString k;
 			"value",JString v;
-		] :: acc) com.defines.values []);
+		] :: acc) defines.values []);
 	] in
-	cs.signs <- (sign,{cs_json = jo;cs_index = i}) :: cs.signs;
-	i
+	cc.c_json <- jo;
+	cc.c_index
 
-let maybe_add_context_sign cs com desc =
-	let sign = Define.get_signature com.defines in
-	if not (has_sign cs sign) then ignore (add_sign cs sign desc com)
-
-let get_signs cs =
-	cs.signs
+let get_caches cs =
+	cs.cache.c_contexts
 
 (* modules *)
 
-let find_module cs key =
-	Hashtbl.find cs.cache.c_modules key
+let find_module cc path =
+	Hashtbl.find cc.c_modules path
 
-let cache_module cs key value =
-	Hashtbl.replace cs.cache.c_modules key value
+let cache_module cc path value =
+	Hashtbl.replace cc.c_modules path value
 
 let taint_modules cs file =
-	Hashtbl.iter (fun _ m -> if m.m_extra.m_file = file then m.m_extra.m_dirty <- Some m) cs.cache.c_modules
+	Hashtbl.iter (fun _ cc ->
+		Hashtbl.iter (fun _ m ->
+			if m.m_extra.m_file = file then m.m_extra.m_dirty <- Some m
+		) cc.c_modules
+	) cs.cache.c_contexts
 
 let filter_modules cs file =
 	let removed = DynArray.create () in
 	(* TODO: Using filter_map_inplace would be better, but we can't move to OCaml 4.03 yet *)
-	Hashtbl.iter (fun k m ->
-		if m.m_extra.m_file = file then	DynArray.add removed (k,m);
-	) cs.cache.c_modules;
-	DynArray.iter (fun (k,_) -> Hashtbl.remove cs.cache.c_modules k) removed;
+	Hashtbl.iter (fun _ cc ->
+		Hashtbl.iter (fun k m ->
+			if m.m_extra.m_file = file then DynArray.add removed (cc,k,m);
+		) cc.c_modules
+	) cs.cache.c_contexts;
+	DynArray.iter (fun (cc,k,_) -> Hashtbl.remove cc.c_modules k) removed;
 	DynArray.to_list removed
 
-let iter_modules cs com f =
-	let sign = Define.get_signature com.defines in
-	Hashtbl.iter (fun (_,sign') m -> if sign = sign' then f m) cs.cache.c_modules
-
-let is_cached_module cs com path =
-	let sign = Define.get_signature com.defines in
-	Hashtbl.mem cs.cache.c_modules (path,sign)
-
 (* files *)
 
-let find_file cs key =
-	Hashtbl.find cs.cache.c_files key
+let find_file cc key =
+	Hashtbl.find cc.c_files key
 
-let cache_file cs key time data =
-	Hashtbl.replace cs.cache.c_files key { c_time = time; c_package = fst data; c_decls = snd data; c_module_name = None }
+let cache_file cc key time data =
+	Hashtbl.replace cc.c_files key { c_time = time; c_package = fst data; c_decls = snd data; c_module_name = None }
 
-let remove_file cs key =
-	if Hashtbl.mem cs.cache.c_files key then begin
-		Hashtbl.remove cs.cache.c_files key;
-		Hashtbl.replace cs.cache.c_removed_files key ()
+let remove_file cc key =
+	if Hashtbl.mem cc.c_files key then begin
+		Hashtbl.remove cc.c_files key;
+		Hashtbl.replace cc.c_removed_files key ()
 	end
 
 (* Like remove_file, but doesn't keep track of the file *)
-let remove_file_for_real cs key =
-	Hashtbl.remove cs.cache.c_files key
+let remove_file_for_real cc key =
+	Hashtbl.remove cc.c_files key
 
 let remove_files cs file =
-	List.iter (fun (sign,_) -> remove_file cs (file,sign)) cs.signs
-
-let iter_files cs com f =
-	let sign = Define.get_signature com.defines in
-	Hashtbl.iter (fun (file,sign') decls -> if sign = sign' then f file decls) cs.cache.c_files
-
-let get_file_list cs com =
-	let sign = Define.get_signature com.defines in
-	Hashtbl.fold (fun (file,sign') decls acc -> if sign = sign' then (file,decls) :: acc else acc) cs.cache.c_files []
+	Hashtbl.iter (fun _ cc-> remove_file cc file) cs.cache.c_contexts
 
 let get_module_name_of_cfile file cfile = match cfile.c_module_name with
 	| None ->
@@ -183,7 +170,9 @@ let get_module_name_of_cfile file cfile = match cfile.c_module_name with
 		name
 
 let get_files cs =
-	cs.cache.c_files
+	Hashtbl.fold (fun sign cc acc ->
+		Hashtbl.fold (fun file cfile acc -> (sign,file,cfile) :: acc) cc.c_files acc
+	) cs.cache.c_contexts []
 
 (* haxelibs *)
 
@@ -227,71 +216,4 @@ let add_directory cs key value =
 		add_directories cs key [value]
 
 let clear_directories cs key =
-	Hashtbl.remove cs.cache.c_directories key
-
-(* native lib *)
-
-let add_native_lib cs key files timestamp =
-	Hashtbl.replace cs.cache.c_native_libs key { c_nl_files = files; c_nl_mtime = timestamp }
-
-let get_native_lib cs key =
-	try Some (Hashtbl.find cs.cache.c_native_libs key)
-	with Not_found -> None
-
-let handle_native_lib com lib =
-	com.native_libs.all_libs <- lib#get_file_path :: com.native_libs.all_libs;
-	com.load_extern_type <- com.load_extern_type @ [lib#get_file_path,lib#build];
-	match get() with
-	| Some cs when not (Define.raw_defined com.defines "haxe.noNativeLibsCache") ->
-		let init () =
-			let file = lib#get_file_path in
-			let key = file in
-			let ftime = file_time file in
-			begin match get_native_lib cs key with
-			| Some lib when ftime <= lib.c_nl_mtime ->
-				(* Cached lib is good, set up lookup into cached files. *)
-				lib.c_nl_files;
-			| _ ->
-				(* Cached lib is outdated or doesn't exist yet, read library. *)
-				lib#load;
-				(* Created lookup and eagerly read each known type. *)
-				let h = Hashtbl.create 0 in
-				List.iter (fun path ->
-					if not (Hashtbl.mem h path) then begin
-						let p = { pfile = file ^ " @ " ^ Globals.s_type_path path; pmin = 0; pmax = 0; } in
-						try begin match lib#build path p with
-						| Some r -> Hashtbl.add h path r
-						| None -> ()
-						end with _ ->
-							()
-					end
-				) lib#list_modules;
-				(* Save and set up lookup. *)
-				add_native_lib cs key h ftime;
-				h;
-			end;
-		in
-		(fun () ->
-			let lut = init() in
-			let build path p =
-				try Some (Hashtbl.find lut path)
-				with Not_found -> None
-			in
-			com.load_extern_type <- List.map (fun (name,f) ->
-				name,if name = lib#get_file_path then build else f
-			) com.load_extern_type
-		)
-	| _ ->
-		(* Offline mode, just read library as usual. *)
-		(fun () -> lib#load)
-
-(* context *)
-
-let rec cache_context cs com =
-	let cache_module m =
-		cache_module cs (m.m_path,m.m_extra.m_sign) m;
-	in
-	List.iter cache_module com.modules;
-	match com.get_macros() with
-	| None -> ()
-	| Some com -> cache_context cs com
+	Hashtbl.remove cs.cache.c_directories key

src/context/display/displayJson.ml

@@ -151,30 +151,33 @@ let handler =
 		);
 		"server/readClassPaths", (fun hctx ->
 			hctx.com.callbacks#add_after_init_macros (fun () ->
-				CompilationServer.set_initialized hctx.display#get_cs (Define.get_signature hctx.com.defines) true;
+				let cc = CompilationServer.get_cache hctx.display#get_cs (Define.get_signature hctx.com.defines) in
+				cc.c_initialized <- true;
 				DisplayToplevel.read_class_paths hctx.com ["init"];
 				let files = CompilationServer.get_files hctx.display#get_cs in
 				hctx.send_result (jobject [
-					"files", jint (Hashtbl.length files)
+					"files", jint (List.length files)
 				]);
 			)
 		);
 		"server/contexts", (fun hctx ->
-			let l = List.map (fun (sign,csign) -> csign.cs_json) (CompilationServer.get_signs hctx.display#get_cs) in
+			let l = Hashtbl.fold (fun _ cc acc -> cc.c_json :: acc) (CompilationServer.get_caches hctx.display#get_cs) [] in
 			hctx.send_result (jarray l)
 		);
 		"server/modules", (fun hctx ->
 			let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
-			let l = Hashtbl.fold (fun (_,sign') m acc ->
-				if sign = sign' && m.m_extra.m_kind <> MFake then jstring (s_type_path m.m_path) :: acc else acc
-			) hctx.display#get_cs.cache.c_modules [] in
+			let cc = get_cache hctx.display#get_cs sign in
+			let l = Hashtbl.fold (fun _ m acc ->
+				if m.m_extra.m_kind <> MFake then jstring (s_type_path m.m_path) :: acc else acc
+			) cc.c_modules [] in
 			hctx.send_result (jarray l)
 		);
 		"server/module", (fun hctx ->
 			let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
 			let path = Path.parse_path (hctx.jsonrpc#get_string_param "path") in
+			let cc = get_cache hctx.display#get_cs sign in
 			let m = try
-				CompilationServer.find_module hctx.display#get_cs (path,sign)
+				CompilationServer.find_module cc path
 			with Not_found ->
 				hctx.send_error [jstring "No such module"]
 			in
@@ -184,15 +187,15 @@ let handler =
 			let file = hctx.jsonrpc#get_string_param "file" in
 			let file = Path.unique_full_path file in
 			let cs = hctx.display#get_cs in
-			List.iter (fun (sign,_) ->
-				Hashtbl.replace cs.cache.c_removed_files (file,sign) ()
-			) (CompilationServer.get_signs cs);
+			Hashtbl.iter (fun _ cc ->
+				Hashtbl.replace cc.c_removed_files file ()
+			) (CompilationServer.get_caches cs);
 			hctx.send_result (jstring file);
 		);
 		"server/files", (fun hctx ->
 			let sign = Digest.from_hex (hctx.jsonrpc#get_string_param "signature") in
-			let files = CompilationServer.get_files hctx.display#get_cs in
-			let files = Hashtbl.fold (fun (file,sign') decls acc -> if sign = sign' then (file,decls) :: acc else acc) files [] in
+			let cc = get_cache hctx.display#get_cs sign in
+			let files = Hashtbl.fold (fun file cfile acc -> (file,cfile) :: acc) cc.c_files [] in
 			let files = List.sort (fun (file1,_) (file2,_) -> compare file1 file2) files in
 			let files = List.map (fun (file,cfile) ->
 				jobject [

src/context/display/displayToplevel.ml

@@ -73,7 +73,6 @@ let explore_class_paths com timer class_paths recusive f_pack f_module =
 	t()
 
 let read_class_paths com timer =
-	let sign = Define.get_signature com.defines in
 	explore_class_paths com timer (List.filter ((<>) "") com.class_path) true (fun _ -> ()) (fun file path ->
 		(* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *)
 		if not (DisplayPosition.display_position#is_in_file file) then begin
@@ -81,32 +80,29 @@ let read_class_paths com timer =
 			match CompilationServer.get() with
 			| Some cs when pack <> fst path ->
 				let file = Path.unique_full_path file in
-				CompilationServer.remove_file_for_real cs (file,sign)
+				CompilationServer.remove_file_for_real (CommonCache.get_cache cs com) file
 			| _ ->
 				()
 		end
 	)
 
 let init_or_update_server cs com timer_name =
-	let sign = Define.get_signature com.defines in
-	if not (CompilationServer.is_initialized cs sign) then begin
-		CompilationServer.set_initialized cs sign true;
+	let cc = CommonCache.get_cache cs com in
+	if not cc.c_initialized then begin
+		cc.c_initialized <- true;
 		read_class_paths com timer_name
 	end;
 	(* Iterate all removed files of the current context. If they aren't part of the context again,
 		re-parse them and remove them from c_removed_files. *)
-	let sign = Define.get_signature com.defines in
 	let removed_removed_files = DynArray.create () in
-	Hashtbl.iter (fun (file,sign') () ->
-		if sign = sign' then begin
-			DynArray.add removed_removed_files (file,sign');
-			try
-				ignore(find_file cs (file,sign));
-			with Not_found ->
-				try ignore(TypeloadParse.parse_module_file com file null_pos) with _ -> ()
-		end;
-	) cs.cache.c_removed_files;
-	DynArray.iter (Hashtbl.remove cs.cache.c_removed_files) removed_removed_files
+	Hashtbl.iter (fun file () ->
+		DynArray.add removed_removed_files file;
+		try
+			ignore(find_file cc file);
+		with Not_found ->
+			try ignore(TypeloadParse.parse_module_file com file null_pos) with _ -> ()
+	) cc.c_removed_files;
+	DynArray.iter (Hashtbl.remove cc.c_removed_files) removed_removed_files
 
 module CollectionContext = struct
 	open ImportStatus
@@ -398,12 +394,13 @@ let collect ctx tk with_type =
 	| Some cs ->
 		(* online: iter context files *)
 		init_or_update_server cs ctx.com ["display";"toplevel"];
-		let files = CompilationServer.get_file_list cs ctx.com in
+		let cc = CommonCache.get_cache cs ctx.com in
+		let files = cc.c_files in
 		(* Sort files by reverse distance of their package to our current package. *)
-		let files = List.map (fun (file,cfile) ->
+		let files = Hashtbl.fold (fun file cfile acc ->
 			let i = pack_similarity curpack cfile.c_package in
-			(file,cfile),i
-		) files in
+			((file,cfile),i) :: acc
+		) files [] in
 		let files = List.sort (fun (_,i1) (_,i2) -> -compare i1 i2) files in
 		let check_package pack = match List.rev pack with
 			| [] -> ()

src/context/display/findReferences.ml

@@ -149,11 +149,12 @@ let find_possible_references kind name (pack,decls) =
 let find_possible_references tctx cs =
 	let name,pos,kind = Display.ReferencePosition.get () in
 	DisplayToplevel.init_or_update_server cs tctx.com ["display";"references"];
-	let files = CompilationServer.get_file_list cs tctx.com in
+	let cc = CommonCache.get_cache cs tctx.com in
+	let files = cc.c_files in
 	let t = Timer.timer ["display";"references";"candidates"] in
-	List.iter (fun (file,cfile) ->
+	Hashtbl.iter (fun file cfile ->
 		let module_name = CompilationServer.get_module_name_of_cfile file cfile in
-		if not (CompilationServer.is_cached_module cs tctx.com (cfile.c_package,module_name)) then try
+		if not (Hashtbl.mem cc.c_modules (cfile.c_package,module_name)) then try
 			find_possible_references kind name (cfile.c_package,cfile.c_decls);
 		with Exit ->
 			begin try

src/typing/macroContext.ml

@@ -491,7 +491,13 @@ let get_macro_context ctx p =
 		let mctx = ctx.g.do_create com2 in
 		mctx.is_display_file <- false;
 		create_macro_interp ctx mctx;
-		Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com2 "get_macro_context") (CompilationServer.get());
+		begin match CompilationServer.get() with
+		| Some cs ->
+			CommonCache.maybe_add_context_sign cs com2 "get_macro_context";
+			com2.cache <- Some (CommonCache.get_cache cs com2)
+		| None ->
+			()
+		end;
 		api, mctx
 
 let load_macro_module ctx cpath display p =

src/typing/typeload.ml

@@ -741,7 +741,13 @@ let load_core_class ctx c =
 			if ctx.in_macro then Common.define com2 Define.Macro;
 			com2.class_path <- ctx.com.std_path;
 			if com2.display.dms_check_core_api then com2.display <- {com2.display with dms_check_core_api = false};
-			Option.may (fun cs -> CompilationServer.maybe_add_context_sign cs com2 "load_core_class") (CompilationServer.get ());
+			begin match CompilationServer.get() with
+			| Some cs ->
+				CommonCache.maybe_add_context_sign cs com2 "load_core_class";
+				com2.cache <- Some (CommonCache.get_cache cs com2)
+			| None ->
+				()
+			end;
 			let ctx2 = ctx.g.do_create com2 in
 			ctx.g.core_api <- Some ctx2;
 			ctx2