[typer] Delay typer creation to after init macros

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,23 +270,37 @@ 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 display_file_dot_path macro_cache_enabled =
+	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);
+	ServerMessage.compiler_stage com;
+
+	let mctx = List.fold_left (fun mctx path ->
+		Some (MacroContext.call_init_macro ctx.com mctx path)
+	) mctx (List.rev actx.config_macros) in
 	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";
-	com.callbacks#run com.error_ext com.callbacks#get_after_init_macros;
-	run_or_diagnose ctx (fun () ->
-		if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
-		List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
-		Finalization.finalize tctx;
-	) ();
+	Option.may (fun mctx -> MacroContext.finalize_macro_api tctx mctx) mctx;
+	(try begin
+		com.callbacks#run com.error_ext com.callbacks#get_after_init_macros;
+		run_or_diagnose ctx (fun () ->
+			if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
+			List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
+			Finalization.finalize tctx;
+		) ();
+	end with TypeloadParse.DisplayInMacroBlock ->
+		ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true)
+	);
 	com.stage <- CTypingDone;
 	ServerMessage.compiler_stage com;
 	(* If we are trying to find references, let's syntax-explore everything we know to check for the
@@ -295,7 +309,8 @@ let do_type ctx tctx actx =
 		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
 		| _ -> ()
 	end;
-	t()
+	t();
+	(tctx, display_file_dot_path)
 
 let finalize_typing ctx tctx =
 	let t = Timer.timer ["finalize"] in
@@ -314,23 +329,17 @@ let filter ctx tctx =
 	Filters.run tctx ctx.com.main;
 	t()
 
-let call_light_init_macro com path =
-	let open MacroContext in
-	let mctx = create_macro_context com in
-	let api = make_macro_com_api com null_pos in
-	let init = create_macro_interp api mctx in
-	MacroContext.MacroLight.call_init_macro com mctx api path;
-	(init,mctx)
-
 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
+	let macro_cache_enabled = !MacroContext.macro_enable_cache in
+	MacroContext.macro_enable_cache := true;
 	let mctx = match com.platform with
 		| CustomTarget name ->
 			begin try
-				Some (call_light_init_macro com (Printf.sprintf "%s.Init.init()" name))
+				Some (MacroContext.call_init_macro com None (Printf.sprintf "%s.Init.init()" name))
 			with (Error.Error { err_message = Module_not_found ([pack],"Init") }) when pack = name ->
 				(* ignore if <target_name>.Init doesn't exist *)
 				None
@@ -351,16 +360,7 @@ 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;
-		ServerMessage.compiler_stage com;
-		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
-		with TypeloadParse.DisplayInMacroBlock ->
-			ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true);
-		end;
+		let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path macro_cache_enabled 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;

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;

src/context/common.ml

@@ -256,7 +256,6 @@ type json_api = {
 type compiler_stage =
 	| CCreated          (* Context was just created *)
 	| CInitialized      (* Context was initialized (from CLI args and such). *)
-	| CTyperCreated     (* The typer context was just created. *)
 	| CInitMacrosStart  (* Init macros are about to run. *)
 	| CInitMacrosDone   (* Init macros did run - at this point the signature is locked. *)
 	| CTypingDone       (* The typer is done - at this point com.types/modules/main is filled. *)
@@ -274,7 +273,6 @@ type compiler_stage =
 let s_compiler_stage = function
 	| CCreated          -> "CCreated"
 	| CInitialized      -> "CInitialized"
-	| CTyperCreated     -> "CTyperCreated"
 	| CInitMacrosStart  -> "CInitMacrosStart"
 	| CInitMacrosDone   -> "CInitMacrosDone"
 	| CTypingDone       -> "CTypingDone"
@@ -397,6 +395,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;
@@ -829,6 +828,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;

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"

src/macro/macroApi.ml

@@ -1894,7 +1894,7 @@ let macro_api ccom get_api =
 		);
 		"on_after_init_macros", vfun1 (fun f ->
 			let f = prepare_callback f 1 in
-			(get_api()).after_init_macros (fun tl -> ignore(f []));
+			(get_api()).after_init_macros (fun tctx -> ignore(f []));
 			vnull
 		);
 		"on_after_typing", vfun1 (fun f ->

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);
@@ -278,7 +286,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"
@@ -537,7 +549,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 ->
@@ -695,7 +707,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
@@ -712,7 +724,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
@@ -725,7 +737,7 @@ let get_macro_context ctx =
 	| None ->
 		let mctx = create_macro_context ctx.com in
 		let api = make_macro_api ctx 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
@@ -803,10 +815,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;
@@ -820,7 +830,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>".
@@ -1031,27 +1043,29 @@ 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
-	ignore(call_macro mctx args margs call p);
-
-module MacroLight = struct
-	let load_macro_light com mctx api display cpath f p =
-		let api = {api with MacroApi.pos = p} in
-		let meth,mloaded = load_macro'' com mctx display cpath f p in
-		let _,_,{cl_path = cpath},_ = meth in
-		let call args =
-			do_call_macro com api cpath f args p
-		in
-		mctx, meth, call
+let call_init_macro com mctx e =
+	let (path,meth,args,p) = resolve_init_macro com e in
+	let (mctx, api) = match mctx with
+	| Some mctx ->
+		let api = make_macro_com_api com p in
+		(mctx, api)
+	| None ->
+		let mctx = create_macro_context com in
+		let api = make_macro_com_api com p in
+		let init,_ = create_macro_interp api mctx in
+		mctx.g.macros <- Some (init,mctx);
+		(mctx, api)
+	in
 
-	let call_init_macro com mctx api e =
-		let (path,meth,args,p) = resolve_init_macro com e in
-		let mctx, (margs,_,mclass,mfield), call = load_macro_light com mctx api false path meth p in
-		ignore(call_macro mctx args margs call p);
+	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);
+	mctx
 
-end
+let finalize_macro_api tctx mctx =
+	let api = make_macro_api tctx null_pos in
+	match !macro_interp_cache with
+		| None -> ignore(create_macro_interp api mctx)
+		| Some mint -> mint.curapi <- api
 
 let interpret ctx =
 	let mctx = Interp.create ctx.com (make_macro_api ctx null_pos) false in

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 ->

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 =

src/typing/typer.ml

@@ -1991,15 +1991,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 = [];

tests/misc/projects/Issue11128/InitMacro.hx

@@ -0,0 +1,25 @@
+import haxe.macro.Compiler;
+import haxe.macro.Context;
+import haxe.macro.Type;
+
+class InitMacro {
+	static function setup() {
+		switch (Compiler.getConfiguration().platform) {
+			case CustomTarget("mylang"): {}
+			case _: throw "this shouldnt happen.";
+		}
+
+		Context.onAfterTyping(check);
+	}
+
+	static function check(types:Array<ModuleType>) {
+		for (m in types) {
+			switch (m) {
+				case TClassDecl(_.get() => c):
+					for (f in c.fields.get()) f.expr();
+
+				case _:
+			}
+		}
+	}
+}

tests/misc/projects/Issue11128/Main2.hx

@@ -0,0 +1 @@
+function main() {}

tests/misc/projects/Issue11128/compile5.hxml

@@ -0,0 +1,3 @@
+-main Main2
+--custom-target mylang=out
+--macro InitMacro.setup()

tests/misc/projects/Issue11128/mylang/Init.hx

@@ -0,0 +1,6 @@
+package mylang;
+
+class Init {
+	public static function init() {
+	}
+}