From 54f36429e60d25eaf597aee672d91e6bba29c849 Mon Sep 17 00:00:00 2001
From: Rudy Ges <k@klabz.org>
Date: Sat, 30 Sep 2023 21:24:42 +0200
Subject: [PATCH] [typer] delay typer init to after init macros

---
 src/compiler/compiler.ml      | 38 +++++++++++++++++------------
 src/compiler/displayOutput.ml |  2 +-
 src/context/common.ml         |  2 ++
 src/context/typecore.ml       |  3 +--
 src/typing/macroContext.ml    | 46 +++++++++++++++++++++++++----------
 src/typing/typeload.ml        |  2 +-
 src/typing/typeloadCheck.ml   |  2 +-
 src/typing/typer.ml           |  5 ++--
 8 files changed, 63 insertions(+), 37 deletions(-)

diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml
index 64c32ef30fb..4b16d15c59b 100644
--- a/src/compiler/compiler.ml
+++ b/src/compiler/compiler.ml
@@ -156,7 +156,7 @@ module Setup = struct
 				add_std "eval";
 				"eval"
 
-	let create_typer_context ctx native_libs =
+	let create_typer_context ctx macros native_libs =
 		let com = ctx.com in
 		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
 		let buffer = Buffer.create 64 in
@@ -172,7 +172,7 @@ module Setup = struct
 		let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in
 		(* Native lib pass 2: Initialize *)
 		List.iter (fun f -> f()) fl;
-		Typer.create com
+		Typer.create com macros
 
 	let executable_path() =
 		Extc.executable_path()
@@ -270,14 +270,18 @@ let check_defines com =
 	end
 
 (** Creates the typer context and types [classes] into it. *)
-let do_type ctx tctx actx =
-	let com = tctx.Typecore.com in
+let do_type ctx mctx actx =
+	let com = ctx.com in
 	let t = Timer.timer ["typing"] in
 	let cs = com.cs in
 	CommonCache.maybe_add_context_sign cs com "before_init_macros";
 	com.stage <- CInitMacrosStart;
-	List.iter (MacroContext.call_init_macro tctx) (List.rev actx.config_macros);
+	let (mctx, api) = List.fold_left (fun (mctx,api) path ->
+		(MacroContext.call_init_macro ctx.com mctx api path)
+	) (Option.map (fun (_,mctx) -> mctx) mctx, None) (List.rev actx.config_macros) in
 	com.stage <- CInitMacrosDone;
+	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
 	check_defines ctx.com;
 	CommonCache.lock_signature com "after_init_macros";
 	com.callbacks#run com.callbacks#get_after_init_macros;
@@ -293,7 +297,8 @@ let do_type ctx tctx actx =
 		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
 		| _ -> ()
 	end;
-	t()
+	t();
+	tctx
 
 let finalize_typing ctx tctx =
 	let t = Timer.timer ["finalize"] in
@@ -323,7 +328,8 @@ let compile ctx actx callbacks =
 	let com = ctx.com in
 	(* Set up display configuration *)
 	DisplayProcessing.process_display_configuration ctx;
-	let display_file_dot_path = DisplayProcessing.process_display_file com actx in
+	(* TODO handle display *)
+	(* let display_file_dot_path = DisplayProcessing.process_display_file com actx in *)
 	let mctx = match com.platform with
 		| CustomTarget name ->
 			begin try
@@ -347,18 +353,18 @@ let compile ctx actx callbacks =
 		if actx.cmds = [] && not actx.did_something then actx.raise_usage();
 	end else begin
 		(* Actual compilation starts here *)
-		let tctx = Setup.create_typer_context ctx actx.native_libs in
-		tctx.g.macros <- mctx;
 		com.stage <- CTyperCreated;
-		let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
-		begin try
-			do_type ctx tctx actx
+		(* let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in *)
+		let tctx = try
+			do_type ctx mctx actx
 		with TypeloadParse.DisplayInMacroBlock ->
-			ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true);
-		end;
-		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
+			(* TODO *)
+			(* ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true); *)
+			assert false
+		in
+		(* DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path; *)
 		finalize_typing ctx tctx;
-		DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path;
+		(* DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path; *)
 		filter ctx tctx;
 		if ctx.has_error then raise Abort;
 		Generate.check_auxiliary_output com actx;
diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml
index 09e2c31aeef..eaccba4d847 100644
--- a/src/compiler/displayOutput.ml
+++ b/src/compiler/displayOutput.ml
@@ -344,7 +344,7 @@ let handle_type_path_exception ctx p c is_import pos =
 			| None ->
 				DisplayPath.TypePathHandler.complete_type_path com p
 			| Some (c,cur_package) ->
-				let ctx = Typer.create com in
+				let ctx = Typer.create com None in
 				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
 		end with Common.Abort msg ->
 			error_ext ctx msg;
diff --git a/src/context/common.ml b/src/context/common.ml
index 5eecd221283..f3cfd27b161 100644
--- a/src/context/common.ml
+++ b/src/context/common.ml
@@ -379,6 +379,7 @@ type context = {
 	mutable user_metas : (string, Meta.user_meta) Hashtbl.t;
 	mutable get_macros : unit -> context option;
 	(* typing state *)
+	mutable global_metadata : (string list * metadata_entry * (bool * bool * bool)) list;
 	shared : shared_context;
 	display_information : display_information;
 	file_lookup_cache : (string,string option) lookup;
@@ -811,6 +812,7 @@ let create compilation_step cs version args =
 		file = "";
 		types = [];
 		callbacks = new compiler_callbacks;
+		global_metadata = [];
 		modules = [];
 		module_lut = new hashtbl_lookup;
 		module_nonexistent_lut = new hashtbl_lookup;
diff --git a/src/context/typecore.ml b/src/context/typecore.ml
index 8760eafd96f..36a8d8a90cd 100644
--- a/src/context/typecore.ml
+++ b/src/context/typecore.ml
@@ -80,7 +80,6 @@ type typer_globals = {
 	mutable macros : ((unit -> unit) * typer) option;
 	mutable std : module_def;
 	type_patches : (path, (string * bool, type_patch) Hashtbl.t * type_patch) Hashtbl.t;
-	mutable global_metadata : (string list * metadata_entry * (bool * bool * bool)) list;
 	mutable module_check_policies : (string list * module_check_policy list * bool) list;
 	mutable global_using : (tclass * pos) list;
 	(* Indicates that Typer.create() finished building this instance *)
@@ -217,7 +216,7 @@ let analyzer_run_on_expr_ref : (Common.context -> string -> texpr -> texpr) ref
 let cast_or_unify_raise_ref : (typer -> ?uctx:unification_context option -> Type.t -> texpr -> pos -> texpr) ref = ref (fun _ ?uctx _ _ _ -> assert false)
 let type_generic_function_ref : (typer -> field_access -> (unit -> texpr) field_call_candidate -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 
-let create_context_ref : (Common.context -> typer) ref = ref (fun _ -> assert false)
+let create_context_ref : (Common.context -> ((unit -> unit) * typer) option -> typer) ref = ref (fun _ -> assert false)
 
 let pass_name = function
 	| PBuildModule -> "build-module"
diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml
index f329acce66a..c82a1cb3f67 100644
--- a/src/typing/macroContext.ml
+++ b/src/typing/macroContext.ml
@@ -117,6 +117,14 @@ let typing_timer ctx need_type f =
 		raise e
 
 let make_macro_com_api com p =
+	let parse_metadata s p =
+		try
+			match ParserEntry.parse_string Grammar.parse_meta com.defines s null_pos raise_typing_error false with
+			| ParseSuccess(meta,_,_) -> meta
+			| ParseError(_,_,_) -> raise_typing_error "Malformed metadata string" p
+		with _ ->
+			raise_typing_error "Malformed metadata string" p
+	in
 	{
 		MacroApi.pos = p;
 		get_com = (fun () -> com);
@@ -260,7 +268,11 @@ let make_macro_com_api com p =
 			Interp.exc_string "unsupported"
 		);
 		add_global_metadata = (fun s1 s2 config p ->
-			Interp.exc_string "unsupported"
+			let meta = parse_metadata s2 p in
+			List.iter (fun (m,el,_) ->
+				let m = (m,el,p) in
+				com.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: com.global_metadata;
+			) meta;
 		);
 		add_module_check_policy = (fun sl il b i ->
 			Interp.exc_string "unsupported"
@@ -530,7 +542,7 @@ let make_macro_api ctx p =
 			let meta = parse_metadata s2 p in
 			List.iter (fun (m,el,_) ->
 				let m = (m,el,p) in
-				ctx.g.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: ctx.g.global_metadata;
+				ctx.com.global_metadata <- (ExtString.String.nsplit s1 ".",m,config) :: ctx.com.global_metadata;
 			) meta;
 		);
 		MacroApi.add_module_check_policy = (fun sl il b i ->
@@ -705,7 +717,7 @@ let create_macro_context com =
 	com2.defines.defines_signature <- None;
 	com2.platform <- !Globals.macro_platform;
 	Common.init_platform com2;
-	let mctx = !create_context_ref com2 in
+	let mctx = !create_context_ref com2 None in
 	mctx.is_display_file <- false;
 	CommonCache.lock_signature com2 "get_macro_context";
 	mctx
@@ -717,9 +729,8 @@ let get_macro_context ctx =
 		ctx
 	| None ->
 		let mctx = create_macro_context ctx.com in
-		let api = make_macro_api ctx null_pos in
+		let api = make_macro_api mctx null_pos in
 		let init = create_macro_interp api mctx in
-		ctx.g.macros <- Some (init,mctx);
 		mctx.g.macros <- Some (init,mctx);
 		mctx
 
@@ -796,10 +807,8 @@ let do_call_macro com api cpath f args p =
 	if com.verbose then Common.log com ("Exiting macro " ^ s_type_path cpath ^ "." ^ f);
 	r
 
-let load_macro ctx display cpath f p =
-	let api = make_macro_api ctx p in
-	let mctx = get_macro_context ctx in
-	let meth,mloaded = load_macro'' ctx.com mctx display cpath f p in
+let load_macro ctx com mctx api display cpath f p =
+	let meth,mloaded = load_macro'' com mctx display cpath f p in
 	let _,_,{cl_path = cpath},_ = meth in
 	let call args =
 		add_dependency ctx.m.curmod mloaded;
@@ -813,7 +822,9 @@ type macro_arg_type =
 	| MAOther
 
 let type_macro ctx mode cpath f (el:Ast.expr list) p =
-	let mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx (mode = MDisplay) cpath f p in
+	let api = make_macro_api ctx p in
+	let mctx = get_macro_context ctx in
+	let mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx ctx.com mctx api (mode = MDisplay) cpath f p in
 	let margs =
 		(*
 			Replace "rest:haxe.Rest<Expr>" in macro signatures with "rest:Array<Expr>".
@@ -1024,10 +1035,19 @@ let resolve_init_macro com e =
 	| _ ->
 		raise_typing_error "Invalid macro call" p
 
-let call_init_macro ctx e =
-	let (path,meth,args,p) = resolve_init_macro ctx.com e in
-	let mctx, (margs,_,mclass,mfield), call = load_macro ctx false path meth p in
+let call_init_macro com mctx api e =
+	let mctx = match mctx with Some mctx -> mctx | None -> create_macro_context com in
+	let api = match api with Some api -> api | None ->
+		let api = make_macro_com_api com null_pos in
+		let init = create_macro_interp api mctx in
+		init();
+		api
+	in
+
+	let (path,meth,args,p) = resolve_init_macro com e in
+	let mctx, (margs,_,mclass,mfield), call = load_macro mctx com mctx api false path meth p in
 	ignore(call_macro mctx args margs call p);
+	(Some mctx, Some api)
 
 module MacroLight = struct
 	let load_macro_light com mctx api display cpath f p =
diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml
index 73e8f79a89f..9944878c7b3 100644
--- a/src/typing/typeload.ml
+++ b/src/typing/typeload.ml
@@ -823,7 +823,7 @@ let load_core_class ctx c =
 			com2.class_path <- ctx.com.std_path;
 			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";
-			let ctx2 = !create_context_ref com2 in
+			let ctx2 = !create_context_ref com2 ctx.g.macros in
 			ctx.g.core_api <- Some ctx2;
 			ctx2
 		| Some c ->
diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml
index 3a6e41a3d24..fd2ff03c618 100644
--- a/src/typing/typeloadCheck.ml
+++ b/src/typing/typeloadCheck.ml
@@ -312,7 +312,7 @@ let check_global_metadata ctx meta f_add mpath tpath so =
 	List.iter (fun (sl2,m,(recursive,to_types,to_fields)) ->
 		let add = ((field_mode && to_fields) || (not field_mode && to_types)) && (match_path recursive sl1 sl2) in
 		if add then f_add m
-	) ctx.g.global_metadata;
+	) ctx.com.global_metadata;
 	if ctx.is_display_file then delay ctx PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta)
 
 let check_module_types ctx m p t =
diff --git a/src/typing/typer.ml b/src/typing/typer.ml
index d8fdd8b6717..bac11e40cf6 100644
--- a/src/typing/typer.ml
+++ b/src/typing/typer.ml
@@ -2083,15 +2083,14 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) =
 (* ---------------------------------------------------------------------- *)
 (* TYPER INITIALIZATION *)
 
-let create com =
+let create com macros =
 	let ctx = {
 		com = com;
 		t = com.basic;
 		g = {
 			core_api = None;
-			macros = None;
+			macros = macros;
 			type_patches = Hashtbl.create 0;
-			global_metadata = [];
 			module_check_policies = [];
 			delayed = [];
 			debug_delayed = [];