[debug] support path matching in compile pass debug output

src/context/display/displayTexpr.ml

@@ -63,7 +63,7 @@ let actually_check_display_field ctx c cff p =
 	let display_modifier = Typeload.check_field_access ctx cff in
 	let fctx = TypeloadFields.create_field_context ctx cctx cff true display_modifier in
 	let cf = TypeloadFields.init_field (ctx,cctx,fctx) cff in
-	flush_pass ctx PTypeField "check_display_field";
+	flush_pass ctx PTypeField ("check_display_field",(fst c.cl_path @ [snd c.cl_path;fst cff.cff_name]));
 	ignore(follow cf.cf_type)
 
 let check_display_field ctx sc c cf =

src/context/display/syntaxExplorer.ml

@@ -177,7 +177,7 @@ let explore_uncached_modules tctx cs symbols =
 			begin try
 				let m = tctx.g.do_load_module tctx (cfile.c_package,module_name) null_pos in
 				(* We have to flush immediately so we catch exceptions from weird modules *)
-				Typecore.flush_pass tctx Typecore.PFinal "final";
+				Typecore.flush_pass tctx Typecore.PFinal ("final",cfile.c_package @ [module_name]);
 				m :: acc
 			with _ ->
 				acc

src/context/typecore.ml

@@ -74,7 +74,7 @@ type delay = {
 
 type typer_globals = {
 	mutable delayed : delay list;
-	mutable debug_delayed : (typer_pass * ((unit -> unit) * string * typer) list) list;
+	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
 	doinline : bool;
 	retain_meta : bool;
 	mutable core_api : typer option;
@@ -422,7 +422,7 @@ let delay_if_mono ctx p t f = match follow t with
 	| _ ->
 		f()
 
-let rec flush_pass ctx p (where:string) =
+let rec flush_pass ctx p where =
 	match ctx.g.delayed with
 	| delay :: rest when delay.delay_pass <= p ->
 		(match delay.delay_functions with
@@ -440,7 +440,7 @@ let make_pass ctx f = f
 let init_class_done ctx =
 	ctx.pass <- PTypeField
 
-let exc_protect ?(force=true) ctx f (where:string) =
+let exc_protect ?(force=true) ctx f where =
 	let r = ref (lazy_available t_dynamic) in
 	r := lazy_wait (fun() ->
 		try
@@ -762,8 +762,8 @@ let create_deprecation_context ctx = {
 }
 
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
-(*/*
 
+(*
 let delay_tabs = ref ""
 
 let context_ident com =
@@ -774,28 +774,42 @@ let context_ident com =
 	else
 		"  out "
 
-let debug com str =
+let debug_paths = [
+	(* ["Main"] *)
+]
+
+let debug com (path : string list) str =
 	if Common.raw_defined com "cdebug" then begin
-		let s = (context_ident com ^ string_of_int (String.length !delay_tabs) ^ " " ^ !delay_tabs ^ str) in
-		match com.json_out with
-		| None -> print_endline s
-		| Some _ -> DynArray.add com.pass_debug_messages s
+		let emit () =
+			let s = (context_ident com ^ string_of_int (String.length !delay_tabs) ^ " " ^ !delay_tabs ^ str) in
+			match com.json_out with
+			| None -> print_endline s
+			| Some _ -> DynArray.add com.pass_debug_messages s
+		in
+		match debug_paths,path with
+		| [],_
+		| _,[] ->
+			emit()
+		| l ->
+			if List.exists (Ast.match_path false path) debug_paths then emit();
 	end
 
 let init_class_done ctx =
-	debug ctx.com ("init_class_done " ^ s_type_path ctx.curclass.cl_path);
+	let path = fst ctx.curclass.cl_path @ [snd ctx.curclass.cl_path] in
+	debug ctx.com path ("init_class_done " ^ s_type_path ctx.curclass.cl_path);
 	init_class_done ctx
 
 let ctx_pos ctx =
-	let inf = s_type_path ctx.m.curmod.m_path in
-	let inf = (match snd ctx.curclass.cl_path with "" -> inf | n when n = snd ctx.m.curmod.m_path -> inf | n -> inf ^ "." ^ n) in
-	let inf = (match ctx.curfield.cf_name with "" -> inf | n -> inf ^ ":" ^ n) in
+	let inf = fst ctx.m.curmod.m_path @ [snd ctx.m.curmod.m_path]in
+	let inf = (match snd ctx.curclass.cl_path with "" -> inf | n when n = snd ctx.m.curmod.m_path -> inf | n -> inf @ [n]) in
+	let inf = (match ctx.curfield.cf_name with "" -> inf | n -> inf @ [n]) in
 	inf
 
 let pass_infos ctx p =
-	let inf = pass_name p ^ " ("  ^ ctx_pos ctx ^ ")" in
+	let path = ctx_pos ctx in
+	let inf = pass_name p ^ " ("  ^ String.concat "." path ^ ")" in
 	let inf = if ctx.pass > p then inf ^ " ??CURPASS=" ^ pass_name ctx.pass else inf in
-	inf
+	inf,path
 
 let delay ctx p f =
 	let inf = pass_infos ctx p in
@@ -810,7 +824,7 @@ let delay ctx p f =
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 	in
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
-	debug ctx.com ("add " ^ inf)
+	debug ctx.com (snd inf) ("add " ^ (fst inf))
 
 let delay_late ctx p f =
 	let inf = pass_infos ctx p in
@@ -823,7 +837,7 @@ let delay_late ctx p f =
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 	in
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
-	debug ctx.com ("add late " ^ inf)
+	debug ctx.com (snd inf) ("add late " ^ (fst inf))
 
 let pending_passes ctx =
 	let rec loop acc = function
@@ -832,20 +846,20 @@ let pending_passes ctx =
 	in
 	match loop [] ctx.g.debug_delayed with
 	| [] -> ""
-	| l -> " ??PENDING[" ^ String.concat ";" (List.map (fun (_,i,_) -> i) l) ^ "]"
+	| l -> " ??PENDING[" ^ String.concat ";" (List.map (fun (_,(i,_),_) -> i) l) ^ "]"
 
 let display_error com ?(depth=0) msg p =
-	debug com ("ERROR " ^ msg);
+	debug com [] ("ERROR " ^ msg);
 	display_error com ~depth msg p
 
 let display_error_ext com err =
-	debug com ("ERROR " ^ (error_msg err.err_message));
+	debug com [] ("ERROR " ^ (error_msg err.err_message));
 	display_error_ext com err
 
 let make_pass ?inf ctx f =
-	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
+	let inf,path = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
 	(fun v ->
-		debug ctx.com ("run " ^ inf ^ pending_passes ctx);
+		debug ctx.com path ("run " ^ inf ^ pending_passes ctx);
 		let old = !delay_tabs in
 		delay_tabs := !delay_tabs ^ "\t";
 		let t = (try
@@ -855,7 +869,7 @@ let make_pass ?inf ctx f =
 				delay_tabs := old;
 				raise exc
 			| exc when not (Common.raw_defined ctx.com "stack") ->
-				debug ctx.com ("FATAL " ^ Printexc.to_string exc);
+				debug ctx.com path ("FATAL " ^ Printexc.to_string exc);
 				delay_tabs := old;
 				raise exc
 		) in
@@ -882,16 +896,17 @@ let rec flush_pass ctx p where =
 	match ctx.g.debug_delayed with
 	| (p2,_) :: _ when p2 <= p ->
 		let old = !delay_tabs in
-		debug ctx.com ("flush " ^ pass_name p ^ "(" ^ where ^ ")");
+		debug ctx.com (snd where) ("flush " ^ pass_name p ^ "(" ^ (fst where) ^ ")");
 		delay_tabs := !delay_tabs ^ "\t";
 		loop();
 		delay_tabs := old;
-		debug ctx.com "flush-done";
+		debug ctx.com (snd where) "flush-done";
 	| _ ->
 		()
 
 let make_where ctx where =
-	where ^ " (" ^ ctx_pos ctx ^ ")"
+	let inf = ctx_pos ctx in
+	where ^ " (" ^ String.concat "." inf ^ ")",inf
 
 let exc_protect ?(force=true) ctx f (where:string) =
 	let r = ref (lazy_available t_dynamic) in
@@ -907,7 +922,7 @@ let exc_protect ?(force=true) ctx f (where:string) =
 	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 
-*/*)
+*)
 (* --------------------------------------------------- *)
 
 

src/typing/finalization.ml

@@ -79,7 +79,7 @@ let get_main ctx types =
 		Some main
 
 let finalize ctx =
-	flush_pass ctx PFinal "final";
+	flush_pass ctx PFinal ("final",[]);
 	match ctx.com.callbacks#get_after_typing with
 		| [] ->
 			()
@@ -91,7 +91,7 @@ let finalize ctx =
 					()
 				| new_types ->
 					List.iter (fun f -> f new_types) fl;
-					flush_pass ctx PFinal "final";
+					flush_pass ctx PFinal ("final",[]);
 					loop all_types
 			in
 			loop []

src/typing/macroContext.ml

@@ -94,7 +94,7 @@ let typing_timer ctx need_type f =
 
 	if need_type && ctx.pass < PTypeField then begin
 		ctx.pass <- PTypeField;
-		flush_pass ctx PBuildClass "typing_timer";
+		flush_pass ctx PBuildClass ("typing_timer",[] (* TODO: ? *));
 	end;
 	let exit() =
 		t();
@@ -579,7 +579,7 @@ let make_macro_api ctx mctx p =
 				List.iter (fun path ->
 					ImportHandling.init_using ctx path null_pos
 				) usings;
-				flush_pass ctx PConnectField "with_imports";
+				flush_pass ctx PConnectField ("with_imports",[] (* TODO: ? *));
 				f()
 			in
 			let restore () =

src/typing/typeload.ml

@@ -841,7 +841,7 @@ let load_core_class ctx c =
 		| _ -> mk_type_path c.cl_path
 	in
 	let t = load_instance ctx2 (tpath,c.cl_pos) true in
-	flush_pass ctx2 PFinal "core_final";
+	flush_pass ctx2 PFinal ("core_final",(fst c.cl_path @ [snd c.cl_path]));
 	match t with
 	| TInst (ccore,_) | TAbstract({a_impl = Some ccore}, _) ->
 		ccore

src/typing/typeloadModule.ml

@@ -837,7 +837,7 @@ let load_module' ctx g m p =
 let load_module ctx m p =
 	let m2 = load_module' ctx ctx.g m p in
 	add_dependency ~skip_postprocess:true ctx.m.curmod m2;
-	if ctx.pass = PTypeField then flush_pass ctx PConnectField "load_module";
+	if ctx.pass = PTypeField then flush_pass ctx PConnectField ("load_module",fst m @ [snd m]);
 	m2
 
 (* let load_module ctx m p =