From 87a6c29793b17c3995679ac80a0bcd6d8536c8bc Mon Sep 17 00:00:00 2001
From: Rudy Ges <k@klabz.org>
Date: Tue, 3 Oct 2023 16:37:47 +0200
Subject: [PATCH] [typer] rework after init macro

---
 src/compiler/compiler.ml   |  2 ++
 src/macro/macroApi.ml      |  7 +++----
 src/typing/macroContext.ml | 13 ++++++++-----
 3 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml
index caede6bd5fd..f24b8d9d42b 100644
--- a/src/compiler/compiler.ml
+++ b/src/compiler/compiler.ml
@@ -286,11 +286,13 @@ let do_type ctx mctx actx display_file_dot_path =
 	com.stage <- CInitMacrosDone;
 	ServerMessage.compiler_stage com;
 	MacroContext.macro_enable_cache := macro_cache_enabled;
+
 	let macros = match mctx with None -> None | Some mctx -> mctx.g.macros in
 	let tctx = Setup.create_typer_context ctx macros actx.native_libs in
 	let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
 	check_defines ctx.com;
 	CommonCache.lock_signature com "after_init_macros";
+	Option.may (fun mctx -> MacroContext.finalize_macro_api tctx mctx) mctx;
 
 	(try begin
 		com.callbacks#run com.callbacks#get_after_init_macros;
diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml
index 4eb2bc0a7b8..24ae6f6ebe0 100644
--- a/src/macro/macroApi.ml
+++ b/src/macro/macroApi.ml
@@ -19,7 +19,6 @@ type compiler_options = {
 **)
 
 type 'value compiler_api = {
-	is_full : bool;
 	pos : Globals.pos;
 	get_com : unit -> Common.context;
 	get_macro_stack : unit -> pos list;
@@ -1894,10 +1893,10 @@ let macro_api ccom get_api =
 			encode_array (List.map encode_type ((get_api()).get_module (decode_string s)))
 		);
 		"on_after_init_macros", vfun1 (fun f ->
-			if (get_api()).is_full then begin
+			(get_api()).after_init_macros (fun tctx ->
 				let f = prepare_callback f 1 in
-				(get_api()).after_init_macros (fun tctx -> ignore(f []));
-			end;
+				ignore(f [])
+			);
 			vnull
 		);
 		"on_after_typing", vfun1 (fun f ->
diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml
index ef1507421e6..64131ae766b 100644
--- a/src/typing/macroContext.ml
+++ b/src/typing/macroContext.ml
@@ -127,7 +127,6 @@ let make_macro_com_api com p =
 	in
 	{
 		MacroApi.pos = p;
-		MacroApi.is_full = false;
 		get_com = (fun () -> com);
 		get_macro_stack = (fun () ->
 			let envs = Interp.call_stack (Interp.get_eval (Interp.get_ctx ())) in
@@ -317,7 +316,6 @@ and promote_com_api com_api ctx p =
 	in
 	{
 		com_api with
-		MacroApi.is_full = true;
 		MacroApi.get_type = (fun s ->
 			typing_timer ctx false (fun() ->
 				let path = parse_path s in
@@ -705,7 +703,7 @@ let create_macro_interp api mctx =
 	init();
 	let init = (fun() -> Interp.select mint) in
 	mctx.g.macros <- Some (init,mctx);
-	init
+	(init, mint)
 
 let create_macro_context com =
 	let com2 = Common.clone com true in
@@ -735,7 +733,7 @@ let get_macro_context ctx =
 	| None ->
 		let mctx = create_macro_context ctx.com in
 		let api = make_macro_api mctx null_pos in
-		let init = create_macro_interp api mctx in
+		let init,_ = create_macro_interp api mctx in
 		ctx.g.macros <- Some (init,mctx);
 		mctx.g.macros <- Some (init,mctx);
 		mctx
@@ -1048,7 +1046,7 @@ let call_init_macro com mctx e =
 	let api = make_macro_com_api com p in
 	(match !macro_interp_cache with
 	| None ->
-		let init = create_macro_interp api mctx in
+		let init,_ = create_macro_interp api mctx in
 		init();
 	| _ -> ());
 
@@ -1056,6 +1054,11 @@ let call_init_macro com mctx e =
 	ignore(call_macro mctx args margs call p);
 	mctx
 
+let finalize_macro_api tctx mctx =
+	let api = make_macro_api tctx null_pos in
+	let mint = (match !macro_interp_cache with None -> snd (create_macro_interp api mctx) | Some mint -> mint) in
+	Interp.do_reuse mint api;
+
 module MacroLight = struct
 	let load_macro_light com mctx api display cpath f p =
 		let api = {api with MacroApi.pos = p} in