[server] change m_dirty to tri-state m_cache_state (#10694)

src/compiler/compilationCache.ml

@@ -170,7 +170,7 @@ 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_dirty <- Some (Tainted reason)
+				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
 		) contexts
 

src/compiler/server.ml

@@ -95,7 +95,6 @@ module ServerCompilationContext = struct
 		class_paths : (Digest.t,string list) Hashtbl.t;
 		(* Increased for each compilation *)
 		mutable compilation_step : int;
-		mutable mark_loop : int;
 		(* A list of delays which are run after compilation *)
 		mutable delays : (unit -> unit) list;
 		(* True if it's an actual compilation, false if it's a display operation *)
@@ -110,7 +109,6 @@ module ServerCompilationContext = struct
 		class_paths = Hashtbl.create 0;
 		changed_directories = Hashtbl.create 0;
 		compilation_step = 0;
-		mark_loop = 0;
 		delays = [];
 		was_compilation = false;
 		macro_context_setup = false;
@@ -339,7 +337,8 @@ let check_module sctx ctx m p =
 			end
 		) paths
 	in
-	let start_mark = sctx.mark_loop in
+	let start_mark = sctx.compilation_step in
+	let unknown_state_modules = ref [] in
 	let rec check m =
 		let check_module_path () =
 			let directories = get_changed_directories sctx ctx in
@@ -414,30 +413,56 @@ let check_module sctx ctx m p =
 				Some reason
 		in
 		(* If the module mark matches our compilation mark, we are done *)
-		if m.m_extra.m_checked = start_mark then
-			m.m_extra.m_dirty
-		else begin
+		if m.m_extra.m_checked = start_mark then begin match m.m_extra.m_cache_state with
+			| MSGood | MSUnknown ->
+				None
+			| MSBad reason ->
+				Some reason
+		end else begin
 			(* Otherwise, set to current compilation mark for recursion *)
 			m.m_extra.m_checked <- start_mark;
-			let dirty = match m.m_extra.m_dirty with
-				| Some _ as dirty ->
+			let dirty = match m.m_extra.m_cache_state with
+				| MSBad reason ->
 					(* If we are already dirty, stick to it. *)
-					dirty
-				| None ->
+					Some reason
+				| MSUnknown	->
+					(* This should not happen because any MSUnknown module is supposed to have the current m_checked. *)
+					die "" __LOC__
+				| MSGood ->
 					(* Otherwise, run the checks *)
+					m.m_extra.m_cache_state <- MSUnknown;
 					check ()
 			in
-			(* Update the module now. It will use this dirty status for the remainder of this compilation. *)
 			begin match dirty with
-			| Some _ ->
-				m.m_extra.m_dirty <- dirty;
+			| Some reason ->
+				(* Update the state if we're dirty. *)
+				m.m_extra.m_cache_state <- MSBad reason;
 			| None ->
-				()
+				(* We cannot update if we're clean because at this point it might just be an assumption.
+				   Instead We add the module to a list which is updated at the end of handling this subgraph. *)
+				unknown_state_modules := m :: !unknown_state_modules;
 			end;
 			dirty
 		end
 	in
-	check m
+	let state = check m in
+	begin match state with
+	| None ->
+		(* If the entire subgraph is clean, we can set all modules to good state *)
+		List.iter (fun m -> m.m_extra.m_cache_state <- MSGood) !unknown_state_modules;
+	| Some _ ->
+		(* Otherwise, unknown state module may or may not be dirty. We didn't check everything eagerly, so we have
+		   to make sure that the module is checked again if it appears in a different check. This is achieved by
+		   setting m_checked to a lower value and assuming Good state again. *)
+		List.iter (fun m -> match m.m_extra.m_cache_state with
+			| MSUnknown ->
+				m.m_extra.m_checked <- start_mark - 1;
+				m.m_extra.m_cache_state <- MSGood;
+			| MSGood | MSBad _ ->
+				()
+		) !unknown_state_modules
+	end;
+	state
 
 (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation
    context. *)
@@ -481,7 +506,6 @@ 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
-	sctx.mark_loop <- sctx.mark_loop + 1;
 	let cc = CommonCache.get_cache com in
 	try
 		let m = cc#find_module mpath in

src/core/json/genjson.ml

@@ -713,7 +713,10 @@ let generate_module ctx m =
 		"types",jlist (fun mt -> generate_type_path m.m_path (t_infos mt).mt_path (t_infos mt).mt_meta) m.m_types;
 		"file",jstring (Path.UniqueKey.lazy_path m.m_extra.m_file);
 		"sign",jstring (Digest.to_hex m.m_extra.m_sign);
-		"dirty",Option.map_default (fun reason -> jstring (Printer.s_module_skip_reason reason)) jnull m.m_extra.m_dirty;
+		"cacheState",jstring (match m.m_extra.m_cache_state with
+			| MSGood -> "Good"
+			| MSBad reason -> Printer.s_module_skip_reason reason
+			| MSUnknown -> "Unknown");
 		"dependencies",jarray (PMap.fold (fun m acc -> (jobject [
 			"path",jstring (s_type_path m.m_path);
 			"sign",jstring (Digest.to_hex m.m_extra.m_sign);

src/core/tFunctions.ml

@@ -158,7 +158,7 @@ let module_extra file sign time kind policy =
 			m_type_hints = [];
 			m_import_positions = PMap.empty;
 		};
-		m_dirty = None;
+		m_cache_state = MSGood;
 		m_added = 0;
 		m_checked = 0;
 		m_time = time;

src/core/tPrinting.ml

@@ -639,12 +639,17 @@ module Printer = struct
 		| Shadowed file -> "Shadowed " ^ file
 		| LibraryChanged -> "LibraryChanged"
 
+	let s_module_cache_state = function
+		| MSGood -> "Good"
+		| MSBad reason -> "Bad: " ^ (s_module_skip_reason reason)
+		| MSUnknown -> "Unknown"
+
 	let s_module_def_extra tabs me =
 		s_record_fields tabs [
 			"m_file",Path.UniqueKey.lazy_path me.m_file;
 			"m_sign",me.m_sign;
 			"m_time",string_of_float me.m_time;
-			"m_dirty",s_opt s_module_skip_reason me.m_dirty;
+			"m_cache_state",s_module_cache_state me.m_cache_state;
 			"m_added",string_of_int me.m_added;
 			"m_checked",string_of_int me.m_checked;
 			"m_deps",s_pmap string_of_int (fun m -> snd m.m_path) me.m_deps;

src/core/tType.ml

@@ -38,6 +38,11 @@ type module_skip_reason =
 	| Shadowed of string
 	| LibraryChanged
 
+type module_cache_state =
+	| MSGood
+	| MSBad of module_skip_reason
+	| MSUnknown
+
 type t =
 	| TMono of tmono
 	| TEnum of tenum * tparams
@@ -363,7 +368,7 @@ and module_def_extra = {
 	m_display : module_def_display;
 	mutable m_check_policy : module_check_policy list;
 	mutable m_time : float;
-	mutable m_dirty : module_skip_reason option;
+	mutable m_cache_state : module_cache_state;
 	mutable m_added : int;
 	mutable m_checked : int;
 	mutable m_processed : int;