add Context.onAfterTyping (see #4714)

src/macro/interp.ml

@@ -98,6 +98,7 @@ type extern_api = {
 	get_com : unit -> Common.context;
 	get_type : string -> Type.t option;
 	get_module : string -> Type.t list;
+	after_typing : (module_type list -> unit) -> unit;
 	on_generate : (Type.t list -> unit) -> unit;
 	after_generate : (unit -> unit) -> unit;
 	on_type_not_found : (string -> value) -> unit;
@@ -206,6 +207,7 @@ let decode_expr_ref = ref (fun e -> assert false)
 let encode_texpr_ref = ref (fun e -> assert false)
 let decode_texpr_ref = ref (fun e -> assert false)
 let encode_clref_ref = ref (fun c -> assert false)
+let encode_module_type_ref = ref (fun mt -> assert false)
 let enc_hash_ref = ref (fun h -> assert false)
 let enc_array_ref = ref (fun l -> assert false)
 let dec_array_ref = ref (fun v -> assert false)
@@ -2251,6 +2253,16 @@ let macro_lib =
 				enc_array (List.map encode_type ((get_ctx()).curapi.get_module s))
 			| _ -> error()
 		);
+		"after_typing", Fun1 (fun f ->
+			match f with
+			| VFunction (Fun1 _) | VClosure _ ->
+				let ctx = get_ctx() in
+				ctx.curapi.after_typing (fun tl ->
+					ignore(catch_errors ctx (fun() -> ctx.do_call VNull f [enc_array (List.map !encode_module_type_ref tl)] null_pos));
+				);
+				VNull
+			| _ -> error()
+		);
 		"on_generate", Fun1 (fun f ->
 			match f with
 			| VFunction (Fun1 _) | VClosure _ ->
@@ -5078,3 +5090,4 @@ encode_import_ref := encode_import;
 decode_import_ref := decode_import;
 eval_expr_ref := eval_expr;
 encode_import_ref := encode_import;
+encode_module_type_ref := encode_module_type;

src/main.ml

@@ -1624,7 +1624,7 @@ try
 		end
 	end;
 	Sys.catch_break false;
-	List.iter (fun f -> f()) (List.rev com.final_filters);
+	List.iter (fun f -> f()) (List.rev com.callbacks.after_generation);
 	if not !no_output then begin
 		List.iter (fun c ->
 			let r = run_command ctx c in

src/optimization/filters.ml

@@ -1050,7 +1050,7 @@ let run com tctx main =
 	] in
 	List.iter (run_expression_filters tctx filters) new_types;
 	next_compilation();
-	List.iter (fun f -> f()) (List.rev com.filters); (* macros onGenerate etc. *)
+	List.iter (fun f -> f()) (List.rev com.callbacks.before_dce); (* macros onGenerate etc. *)
 	List.iter (save_class_state tctx) new_types;
 	(* PASS 2: type filters pre-DCE *)
 	List.iter (fun t ->

src/typing/common.ml

@@ -99,6 +99,12 @@ type display_mode =
 	| DMResolve of string
 	| DMType
 
+type compiler_callback = {
+	mutable after_typing : (module_type list -> unit) list;
+	mutable before_dce : (unit -> unit) list;
+	mutable after_generation : (unit -> unit) list;
+}
+
 type context = {
 	(* config *)
 	version : int;
@@ -118,8 +124,7 @@ type context = {
 	mutable error : string -> pos -> unit;
 	mutable warning : string -> pos -> unit;
 	mutable load_extern_type : (path -> pos -> (string * Ast.package) option) list; (* allow finding types which are not in sources *)
-	mutable filters : (unit -> unit) list;
-	mutable final_filters : (unit -> unit) list;
+	callbacks : compiler_callback;
 	mutable defines_signature : string option;
 	mutable print : string -> unit;
 	mutable get_macros : unit -> context option;
@@ -672,8 +677,11 @@ let create v args =
 		package_rules = PMap.empty;
 		file = "";
 		types = [];
-		filters = [];
-		final_filters = [];
+		callbacks = {
+			after_typing = [];
+			before_dce = [];
+			after_generation = [];
+		};
 		modules = [];
 		main = None;
 		flash_version = 10.;
@@ -896,11 +904,14 @@ let error msg p = raise (Abort (msg,p))
 
 let platform ctx p = ctx.platform = p
 
+let add_typing_filter ctx f =
+	ctx.callbacks.after_typing <- f :: ctx.callbacks.after_typing
+
 let add_filter ctx f =
-	ctx.filters <- f :: ctx.filters
+	ctx.callbacks.before_dce <- f :: ctx.callbacks.before_dce
 
 let add_final_filter ctx f =
-	ctx.final_filters <- f :: ctx.final_filters
+	ctx.callbacks.after_generation <- f :: ctx.callbacks.after_generation
 
 let find_file ctx f =
 	try

src/typing/typer.ml

@@ -4274,7 +4274,22 @@ let get_main ctx =
 		Some (mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos)
 
 let finalize ctx =
-	flush_pass ctx PFinal "final"
+	flush_pass ctx PFinal "final";
+	match ctx.com.callbacks.after_typing with
+		| [] ->
+			()
+		| fl ->
+			let rec loop handled_types =
+				let all_types = Hashtbl.fold (fun _ m acc -> m.m_types @ acc) ctx.g.modules [] in
+				match (List.filter (fun mt -> not (List.memq mt handled_types)) all_types) with
+				| [] ->
+					()
+				| new_types ->
+					List.iter (fun f -> f new_types) fl;
+					flush_pass ctx PFinal "final";
+					loop all_types
+			in
+			loop []
 
 type state =
 	| Generating
@@ -4471,6 +4486,13 @@ let make_macro_api ctx p =
 				m
 			)
 		);
+		Interp.after_typing = (fun f ->
+			Common.add_typing_filter ctx.com (fun tl ->
+				let t = macro_timer ctx "afterTyping" in
+				f tl;
+				t()
+			)
+		);
 		Interp.on_generate = (fun f ->
 			Common.add_filter ctx.com (fun() ->
 				let t = macro_timer ctx "onGenerate" in

std/haxe/macro/Context.hx

@@ -335,6 +335,18 @@ class Context {
 		load("after_generate",1)(callback);
 	}
 
+	/**
+		Adds a callback function `callback` which is invoked after the compiler
+		is done typing, but before optimization. The callback receives the types
+		which have been typed.
+
+		It is possible to define new types in the callback, in which case it
+		will be called again with the new types as argument.
+	**/
+	public static function onAfterTyping( callback : Array<haxe.macro.Type.ModuleType> -> Void ) {
+		load("after_typing",1)(callback);
+	}
+
 	/**
 		Adds a callback function `callback` which is invoked when a type name
 		cannot be resolved.