[server] only discard stale contexts that no live context depend on

src/compiler/compilationCache.ml

@@ -41,6 +41,7 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 	val mutable json = JNull
 	val mutable initialized = false
 	val mutable last_access_time = Unix.gettimeofday ()
+	val children : (Digest.t,unit) Hashtbl.t = Hashtbl.create 0
 
 	(* files *)
 
@@ -153,6 +154,11 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 
 	method update_access_time = last_access_time <- Unix.gettimeofday ()
 	method get_last_access_time = last_access_time
+
+	(* child contexts *)
+
+	method add_child (child_sign : Digest.t) = Hashtbl.replace children child_sign ()
+	method get_children = children
 end
 
 let create_directory path mtime = {
@@ -378,19 +384,53 @@ class cache = object(self)
 
 	(* Remove context caches that haven't been accessed for [max_age_seconds] seconds.
 	   This prevents unbounded accumulation of stale contexts when defines change between
-	   compilations, creating new signatures each time. *)
+	   compilations, creating new signatures each time.
+
+	   A stale context is only removed if no live (non-stale) context transitively
+	   reaches it via `children` edges. Otherwise the next dep walk on a live
+	   module would `get_context` the removed signature, get back a freshly-created
+	   empty context, and crash with "Could not find dependency". *)
 	method remove_stale_contexts max_age_seconds =
 		let now = Unix.gettimeofday () in
-		let threshold = now -. max_age_seconds in
-		let to_remove = Hashtbl.fold (fun sign cc acc ->
-			if cc#get_last_access_time < threshold then sign :: acc else acc
-		) contexts [] in
-		List.iter (fun sign ->
-			Hashtbl.remove contexts sign
-		) to_remove;
-		if to_remove <> [] then
-			context_list <- List.filter (fun cc -> cc#get_last_access_time >= threshold) context_list;
-		List.length to_remove
+		let threshold = now -. (float_of_int max_age_seconds) in
+		let is_stale cc = cc#get_last_access_time < threshold in
+		(* Short-circuit: nothing stale, nothing to do. *)
+		let any_stale = Hashtbl.fold (fun _ cc acc -> acc || is_stale cc) contexts false in
+		if not any_stale then 0
+		else begin
+			(* Transitive closure of "kept": start with non-stale contexts, follow
+			   each kept context's children edges. *)
+			let kept = Hashtbl.create 0 in
+			let worklist = ref [] in
+			Hashtbl.iter (fun sign cc ->
+				if not (is_stale cc) then begin
+					Hashtbl.replace kept sign ();
+					worklist := cc :: !worklist
+				end
+			) contexts;
+			while !worklist <> [] do
+				let cc = List.hd !worklist in
+				worklist := List.tl !worklist;
+				Hashtbl.iter (fun target_sign () ->
+					if not (Hashtbl.mem kept target_sign) then begin
+						Hashtbl.replace kept target_sign ();
+						match Hashtbl.find_opt contexts target_sign with
+						| Some target_cc -> worklist := target_cc :: !worklist
+						| None -> ()
+					end
+				) cc#get_children
+			done;
+			let to_remove = Hashtbl.fold (fun sign cc acc ->
+				if is_stale cc && not (Hashtbl.mem kept sign) then sign :: acc else acc
+			) contexts [] in
+			List.iter (fun sign -> Hashtbl.remove contexts sign) to_remove;
+			if to_remove <> [] then begin
+				let removed_set = Hashtbl.create (List.length to_remove) in
+				List.iter (fun s -> Hashtbl.replace removed_set s ()) to_remove;
+				context_list <- List.filter (fun cc -> not (Hashtbl.mem removed_set cc#get_sign)) context_list
+			end;
+			List.length to_remove
+		end
 
 	(* Pointers for memory inspection. *)
 	method get_pointers : unit array =

src/compiler/server/serverCache.ml

@@ -557,11 +557,6 @@ let ensure_macro_setup sctx =
 		MacroContext.setup();
 	end
 
-(* Maximum age in seconds for unused context caches before they are removed.
-   10 minutes is long enough to survive bursts of display requests with
-   varying defines, while still cleaning up contexts that are truly abandoned. *)
-let stale_context_max_age_seconds = 600.
-
 let cleanup sctx =
 	begin match !MacroContext.macro_interp_cache with
 	| Some interp ->
@@ -575,7 +570,7 @@ let cleanup sctx =
 	(* Remove context caches that haven't been accessed within the max age window.
 	   This prevents unbounded accumulation of stale contexts when compilation defines
 	   change between requests, generating new cache signatures each time. *)
-	let removed = sctx.cs#remove_stale_contexts stale_context_max_age_seconds in
+	let removed = sctx.cs#remove_stale_contexts !ServerConfig.stale_context_max_age_seconds in
 	if removed > 0 then
 		ServerMessage.message (Printf.sprintf "Removed %d stale context cache(s)" removed)
 

src/compiler/server/serverConfig.ml

@@ -2,6 +2,13 @@ let do_not_check_modules = ref false
 
 let max_completion_items = ref 0
 
+(* Maximum age in seconds for unused context caches before they are removed.
+   10 minutes is long enough to survive bursts of display requests with
+   varying defines, while still cleaning up contexts that are truly abandoned. *)
+let default_stale_context_max_age = 600
+let stale_context_max_age_seconds = ref default_stale_context_max_age
+
 let reset () =
 	do_not_check_modules := false;
-	max_completion_items := 0
+	max_completion_items := 0;
+	stale_context_max_age_seconds := default_stale_context_max_age

src/context/commonCache.ml

@@ -120,7 +120,9 @@ let rec cache_context cs com =
 	) a;
 	begin match com.get_macros() with
 		| None -> ()
-		| Some com -> cache_context cs com
+		| Some macro_com ->
+			cc#add_child (get_cache_sign macro_com);
+			cache_context cs macro_com
 	end;
 	if Define.defined com.defines HxbStats then
 		HxbReader.dump_stats (platform_name com.platform) com.hxb_reader_stats

src/context/display/displayJson.ml

@@ -203,7 +203,8 @@ let handler =
 	let l = [
 		"initialize", (fun hctx ->
 			supports_resolve := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_bool_param "supportsResolve") false;
-			ServerConfig.max_completion_items := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_int_param "maxCompletionItems") 0;
+			hctx.jsonrpc#get_opt_param (fun () -> ServerConfig.max_completion_items := hctx.jsonrpc#get_int_param "maxCompletionItems") ();
+			hctx.jsonrpc#get_opt_param (fun () -> ServerConfig.stale_context_max_age_seconds := hctx.jsonrpc#get_int_param "staleContextMaxAge") ();
 			let exclude = hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_array_param "exclude") [] in
 			DisplayToplevel.exclude := List.map (fun e -> match e with JString s -> s | _ -> die "" __LOC__) exclude;
 			let methods = Hashtbl.fold (fun k _ acc -> (jstring k) :: acc) h [] in

src/typing/typeload.ml

@@ -814,6 +814,7 @@ let load_core_class ctx c =
 			) ctx.com.class_paths#as_list;
 			if com2.display.dms_check_core_api then com2.display <- {com2.display with dms_check_core_api = false};
 			CommonCache.lock_signature com2 "load_core_class";
+			(CommonCache.get_cache ctx.com)#add_child (CommonCache.get_cache_sign com2);
 			let ctx2 = !create_context_ref com2 ctx.g.macros in
 			ctx.g.core_api <- Some ctx2;
 			ctx2

std/haxe/display/Protocol.hx

@@ -63,6 +63,9 @@ typedef InitializeParams = {
 
 	/** The maximum number of completion items to return **/
 	final ?maxCompletionItems:Int;
+
+	/** Maximum age in seconds for unused context caches before they are removed **/
+	final ?staleContextMaxAge:Int;
 }
 
 /**

tests/server/src/TestCase.hx

@@ -287,7 +287,9 @@ class TestCase implements ITest implements ITestCase {
 	}
 
 	function assertSuccess(?p:haxe.PosInfos) {
-		return Assert.isTrue(0 == errorMessages.length, p);
+		var res = 0 == errorMessages.length;
+		if (!res) debugErrorMessages();
+		return Assert.isTrue(res, p);
 	}
 
 	function assertErrorMessage(message:String, ?p:haxe.PosInfos) {

tests/server/src/cases/issues/Issue12807.hx

@@ -0,0 +1,95 @@
+package cases.issues;
+
+import haxe.display.Protocol;
+
+class Issue12807 extends TestCase {
+	static final BUILD_MACRO = "
+		class BuildMacro {
+			public static function build() return null;
+		}
+	";
+
+	static final MAIN = "
+		class Main {
+			public static function main() Other;
+		}
+	";
+
+	static final OTHER = "
+		@:build(BuildMacro.build())
+		class Other {}
+	";
+
+	final args = ["-main", "Main", "--js", "no.js", "--no-output", "-D", "testContextCleanup"];
+
+	function testContextCleanup(_) {
+		vfs.putContent("BuildMacro.macro.hx", BUILD_MACRO);
+		vfs.putContent("Main.hx", MAIN);
+		vfs.putContent("Other.hx", OTHER);
+		vfs.putContent("Empty.hx", getTemplate("Empty.hx"));
+		runHaxeJson([], Methods.Initialize, {staleContextMaxAge: 6});
+
+		// Initial build
+		runHaxe(args);
+		assertSuccess();
+
+		// Any request should trigger cleanup (will happen _after_ the request)
+		var ctx = runHaxeJson([], ServerMethods.Contexts, null);
+		Assert.equals(4, ctx.length);
+
+		// Sleep past the stale-context threshold
+		Sys.sleep(7);
+
+		// Any request should trigger cleanup (will happen _after_ the request)
+		runHaxeJson([], ServerMethods.Contexts, null);
+
+		Sys.sleep(0.1);
+
+		// Everything should be discarded
+		var ctx = runHaxeJson([], ServerMethods.Contexts, null);
+		Assert.equals(0, ctx.length);
+
+		// Still builds fine (rebuilds all context)
+		runHaxe(args);
+		assertSuccess();
+	}
+
+	function testStaleMacroContext(_) {
+		vfs.putContent("BuildMacro.macro.hx", BUILD_MACRO);
+		vfs.putContent("Main.hx", MAIN);
+		vfs.putContent("Other.hx", OTHER);
+		vfs.putContent("Empty.hx", getTemplate("Empty.hx"));
+		runHaxeJson([], Methods.Initialize, {staleContextMaxAge: 6});
+
+		// Initial build
+		runHaxe(args);
+		assertSuccess();
+
+		// Sleep halfway to the stale-context threshold
+		Sys.sleep(3);
+
+		// Run a request that refreshes the main context but not macro context
+		runHaxeJson(args, DisplayMethods.Hover, {file: new FsPath("Empty.hx"), offset: 0});
+		assertSuccess();
+
+		// Sleep past the stale-context threshold
+		Sys.sleep(4);
+
+		// Any request should trigger cleanup (will happen _after_ the request)
+		var ctx = runHaxeJson([], ServerMethods.Contexts, null);
+		Assert.equals(4, ctx.length);
+
+		Sys.sleep(0.1);
+
+		// Both main and macro contexts should still be there
+		// Note: both `load_core_class` will be discarded
+		var ctx = runHaxeJson([], ServerMethods.Contexts, null);
+		Assert.isTrue(Lambda.exists(ctx, c -> c.desc == "get_macro_context"));
+		Assert.isTrue(Lambda.exists(ctx, c -> c.desc == "after_init_macros"));
+
+		// Used to crash: main context depends on macro context that has been discarded
+		// Compiler failure: Could not find dependency BuildMacro of Other in the cache
+		runHaxe(args);
+		assertSuccess();
+	}
+}