Browse Source

pass delay function to server and delay EOM reading

Simon Krajewski 1 year ago
parent
commit
867bf1fd55

+ 6 - 5
src/compiler/server.ml

@@ -467,7 +467,7 @@ let handle_cache_bound_objects com cbol =
 
 (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation
    context. *)
-let rec add_modules sctx com (m : module_def) (from_binary : bool) (p : pos) =
+let rec add_modules sctx com delay (m : module_def) (from_binary : bool) (p : pos) =
 	let own_sign = CommonCache.get_cache_sign com in
 	let rec add_modules tabs m0 m =
 		if m.m_extra.m_added < com.compilation_step then begin
@@ -492,7 +492,7 @@ let rec add_modules sctx com (m : module_def) (from_binary : bool) (p : pos) =
 						let m2 = try
 							com.module_lut#find mpath
 						with Not_found ->
-							match type_module sctx com mpath p with
+							match type_module sctx com delay mpath p with
 							| GoodModule m ->
 								m
 							| BinaryModule mc ->
@@ -512,7 +512,7 @@ let rec add_modules sctx com (m : module_def) (from_binary : bool) (p : pos) =
 
 (* Looks up the module referred to by [mpath] in the cache. If it exists, a check is made to
    determine if it's still valid. If this function returns None, the module is re-typed. *)
-and type_module sctx com mpath p =
+and type_module sctx com delay mpath p =
 	let t = Timer.timer ["server";"module cache"] in
 	let cc = CommonCache.get_cache com in
 	let skip m_path reason =
@@ -521,7 +521,7 @@ and type_module sctx com mpath p =
 	in
 	let add_modules from_binary m =
 		let tadd = Timer.timer ["server";"module cache";"add modules"] in
-		add_modules sctx com m from_binary p;
+		add_modules sctx com delay m from_binary p;
 		tadd();
 		GoodModule m
 	in
@@ -582,7 +582,8 @@ and type_module sctx com mpath p =
 					(* We try to avoid reading expressions as much as possible, so we only do this for
 					   our current display file if we're in display mode. *)
 					let is_display_file = DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file) in
-					if is_display_file || com.display.dms_full_typing then ignore(f_next chunks EOM);
+					if is_display_file || com.display.dms_full_typing then ignore(f_next chunks EOM)
+					else delay (fun () -> ignore(f_next chunks EOM));
 					add_modules true m;
 				| Some reason ->
 					skip mpath reason

+ 1 - 1
src/context/display/displayTexpr.ml

@@ -173,7 +173,7 @@ let check_display_file ctx cs =
 			let m = try
 				ctx.com.module_lut#find path
 			with Not_found ->
-				begin match !TypeloadCacheHook.type_module_hook ctx.com path null_pos with
+				begin match !TypeloadCacheHook.type_module_hook ctx.com (delay ctx.g PTypeField) path null_pos with
 				| NoModule | BadModule _ -> raise Not_found
 				| BinaryModule mc ->
 					let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in

+ 2 - 2
src/context/typecore.ml

@@ -466,14 +466,14 @@ let is_gen_local v = match v.v_kind with
 	| _ ->
 		false
 
-let delay g p f =
+let delay g (p : typer_pass) f =
 	let p = Obj.magic p in
 	let tasks = g.delayed.(p) in
 	tasks.tasks <- f :: tasks.tasks;
 	if p < g.delayed_min_index then
 		g.delayed_min_index <- p
 
-let delay_late g p f =
+let delay_late g (p : typer_pass) f =
 	let p = Obj.magic p in
 	let tasks = g.delayed.(p) in
 	tasks.tasks <- tasks.tasks @ [f];

+ 1 - 1
src/typing/typeloadCacheHook.ml

@@ -9,7 +9,7 @@ type find_module_result =
 	| BinaryModule of HxbData.module_cache
 	| NoModule
 
-let type_module_hook : (Common.context -> path -> pos -> find_module_result) ref = ref (fun _ _ _ -> NoModule)
+let type_module_hook : (Common.context -> ((unit -> unit) -> unit) -> path -> pos -> find_module_result) ref = ref (fun _ _ _ _ -> NoModule)
 
 let fake_modules = Hashtbl.create 0
 

+ 1 - 1
src/typing/typeloadModule.ml

@@ -804,7 +804,7 @@ and load_module' com g m p =
 		com.module_lut#find m
 	with Not_found ->
 		(* Check cache *)
-		match !TypeloadCacheHook.type_module_hook com m p with
+		match !TypeloadCacheHook.type_module_hook com (delay g PTypeField) m p with
 		| GoodModule m ->
 			m
 		| BinaryModule _ ->