[typer] promote macro api to full api after init macros

src/compiler/compiler.ml

@@ -275,13 +275,17 @@ let do_type ctx mctx actx =
 	let t = Timer.timer ["typing"] in
 	let cs = com.cs in
 	CommonCache.maybe_add_context_sign cs com "before_init_macros";
+	let macro_cache_enabled = !MacroContext.macro_enable_cache in
+	MacroContext.macro_enable_cache := true;
 	com.stage <- CInitMacrosStart;
 	ServerMessage.compiler_stage com;
-	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
+
+	let mctx = List.fold_left (fun mctx path ->
+		Some (MacroContext.call_init_macro ctx.com mctx path)
+	) (Option.map (fun (_,mctx) -> mctx) 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
 	check_defines ctx.com;
@@ -330,6 +334,7 @@ let call_light_init_macro com path =
 
 let compile ctx actx callbacks =
 	let com = ctx.com in
+	MacroContext.macro_interp_cache := None;
 	(* Set up display configuration *)
 	DisplayProcessing.process_display_configuration ctx;
 	(* TODO handle display *)

src/macro/macroApi.ml

@@ -19,6 +19,7 @@ type compiler_options = {
 **)
 
 type 'value compiler_api = {
+	is_full : bool;
 	pos : Globals.pos;
 	get_com : unit -> Common.context;
 	get_macro_stack : unit -> pos list;
@@ -1893,8 +1894,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 ->
-			let f = prepare_callback f 1 in
-			(get_api()).after_init_macros (fun tl -> ignore(f []));
+			if (get_api()).is_full then begin
+				let f = prepare_callback f 1 in
+				(get_api()).after_init_macros (fun tctx -> ignore(f []));
+			end;
 			vnull
 		);
 		"on_after_typing", vfun1 (fun f ->

src/typing/macroContext.ml

@@ -127,6 +127,7 @@ 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
@@ -294,11 +295,11 @@ let make_macro_com_api com p =
 			com.info ~depth msg p
 		);
 		warning = (fun ?(depth=0) w msg p ->
-			Interp.exc_string "unsupported"
+			com.warning ~depth w [] msg p
 		);
 	}
 
-let make_macro_api ctx p =
+and promote_com_api com_api ctx p =
 	let parse_expr_string s p inl =
 		typing_timer ctx false (fun() ->
 			match ParserEntry.parse_expr_string ctx.com.defines s p raise_typing_error inl with
@@ -314,9 +315,9 @@ let make_macro_api ctx p =
 		with _ ->
 			raise_typing_error "Malformed metadata string" p
 	in
-	let com_api = make_macro_com_api ctx.com 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
@@ -602,6 +603,10 @@ let make_macro_api ctx p =
 		);
 	}
 
+let make_macro_api ctx p =
+	let com_api = make_macro_com_api ctx.com p in
+	promote_com_api com_api ctx p
+
 let init_macro_interp mctx mint =
 	let p = null_pos in
 	ignore(TypeloadModule.load_module mctx (["haxe";"macro"],"Expr") p);
@@ -1036,19 +1041,20 @@ let resolve_init_macro com e =
 	| _ ->
 		raise_typing_error "Invalid macro call" p
 
-let call_init_macro com mctx api e =
+let call_init_macro com mctx e =
+	let (path,meth,args,p) = resolve_init_macro com e in
+
 	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 api = make_macro_com_api com p in
+	(match !macro_interp_cache with
+	| None ->
 		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)
+	mctx
 
 module MacroLight = struct
 	let load_macro_light com mctx api display cpath f p =