Browse Source

[server] unset cf_expr during maintenance

see #8736
Simon Krajewski 6 years ago
parent
commit
202ef67a51
2 changed files with 45 additions and 0 deletions
  1. 38 0
      src/compiler/server.ml
  2. 7 0
      src/context/compilationServer.ml

+ 38 - 0
src/compiler/server.ml

@@ -599,6 +599,42 @@ module Tasks = struct
 			Gc.set old_gc;
 			ServerMessage.gc_stats (get_time() -. t0) stats do_compact new_space_overhead
 	end
+
+	class class_maintenance_task (cs : CompilationServer.t) (c : tclass) = object(self)
+		inherit server_task ["module maintenance"] 70
+
+		method private execute =
+			let rec field cf =
+				(* Unset cf_expr. This holds the optimized version for generators, which we don't need to persist. If
+				   we compile again, the semi-optimized expression will be restored by calling cl_restore(). *)
+				cf.cf_expr <- None;
+				List.iter field cf.cf_overloads
+			in
+			(* What we're doing here at the moment is free, so we can just do it in one task. If this ever gets more expensive,
+			   we should spawn a task per-field. *)
+			List.iter field c.cl_ordered_fields;
+			List.iter field c.cl_ordered_statics;
+			Option.may field c.cl_constructor;
+	end
+
+	class module_maintenance_task (cs : CompilationServer.t) (m : module_def) = object(self)
+		inherit server_task ["module maintenance"] 80
+
+		method private execute =
+			List.iter (fun mt -> match mt with
+				| TClassDecl c ->
+					cs#add_task (new class_maintenance_task cs c)
+				| _ ->
+					()
+			) m.m_types
+	end
+
+	class server_exploration_task (cs : CompilationServer.t) = object(self)
+		inherit server_task ["server explore"] 90
+
+		method private execute =
+			cs#iter_modules (fun m -> cs#add_task (new module_maintenance_task cs m))
+	end
 end
 
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
@@ -697,6 +733,8 @@ let wait_loop process_params verbose accept =
 		(* If our connection always blocks, we have to execute all pending tasks now. *)
 		if not support_nonblock then
 			while cs#has_task do cs#get_task#run done
+		else if sctx.was_compilation then
+			cs#add_task (new Tasks.server_exploration_task cs)
 	done
 
 let mk_length_prefixed_communication allow_nonblock chin chout =

+ 7 - 0
src/context/compilationServer.ml

@@ -143,6 +143,13 @@ class cache = object(self)
 
 	(* modules *)
 
+	method iter_modules f =
+		Hashtbl.iter (fun _ cc ->
+			Hashtbl.iter (fun _ m ->
+				f m
+			) cc#get_modules
+		) contexts
+
 	method get_modules =
 		Hashtbl.fold (fun _ cc acc ->
 			Hashtbl.fold (fun _ m acc ->