[hxb] debug printing

src/compiler/hxb/hxbReader.ml

@@ -11,6 +11,13 @@ let c_dim = if no_color then "" else "\x1b[2m"
 let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
+let print_stacktrace () =
+	let stack = Printexc.get_callstack 10 in
+	let lines = Printf.sprintf "%s\n" (Printexc.raw_backtrace_to_string stack) in
+	match (ExtString.String.split_on_char '\n' lines) with
+		| (_ :: (_ :: lines)) -> ServerMessage.debug_msg (Printf.sprintf "%s" (ExtString.String.join "\n" lines))
+		| _ -> die "" __LOC__
+
 class hxb_reader
 	(* (com : Common.context) *)
 	(* (file_ch : IO.input) *)
@@ -92,7 +99,7 @@ class hxb_reader
 	method read_from_string_pool pool =
 		let l = self#read_uleb128 in
 		try pool.(l) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "  Failed getting string #%d\n" l);
+			print_endline (Printf.sprintf "  Failed getting string #%d" l);
 			raise e
 
 	method read_string =
@@ -125,7 +132,7 @@ class hxb_reader
 		let pack = self#read_list (fun () -> self#read_string) in
 		let mname = self#read_string in
 		let tname = self#read_string in
-		(* Printf.eprintf "    Read full path %s\n" (ExtString.String.join "." (pack @ [mname; tname])); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "    Read full path %s" (ExtString.String.join "." (pack @ [mname; tname]))); *)
 		(pack,mname,tname)
 
 	method read_documentation =
@@ -146,7 +153,7 @@ class hxb_reader
 			pmin = min;
 			pmax = max;
 		} in
-		(* Printf.eprintf "Read pos: %s\n" (Printer.s_pos pos); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "Read pos: %s" (Printer.s_pos pos)); *)
 		(* MessageReporting.display_source_at com pos; *)
 		pos
 
@@ -164,45 +171,46 @@ class hxb_reader
 	method read_class_ref =
 		let i = self#read_uleb128 in
 		try classes.(i) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading class ref %i\n" (s_type_path m.m_path) todo_error i);
+			print_endline (Printf.sprintf "[%s] %s reading class ref %i" (s_type_path m.m_path) todo_error i);
 			raise e
 
 	method read_abstract_ref =
 		let i = self#read_uleb128 in
 		try abstracts.(i) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading abstract ref %i\n" (s_type_path m.m_path) todo_error i);
+			print_endline (Printf.sprintf "[%s] %s reading abstract ref %i" (s_type_path m.m_path) todo_error i);
 			raise e
 
 	method read_enum_ref =
 		let i = self#read_uleb128 in
 		try enums.(i) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading enum ref %i\n" (s_type_path m.m_path) todo_error i);
+			print_endline (Printf.sprintf "[%s] %s reading enum ref %i" (s_type_path m.m_path) todo_error i);
 			raise e
 
 	method read_typedef_ref =
 		let i = self#read_uleb128 in
 		try typedefs.(i) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading typedef ref %i\n" (s_type_path m.m_path) todo_error i);
+			print_endline (Printf.sprintf "[%s] %s reading typedef ref %i" (s_type_path m.m_path) todo_error i);
 			raise e
 
 	method read_anon_ref =
 		let i = self#read_uleb128 in
 		try anons.(i) with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon ref %i\n" (s_type_path m.m_path) todo_error i);
+			print_endline (Printf.sprintf "[%s] %s reading anon ref %i" (s_type_path m.m_path) todo_error i);
 			raise e
 
 	method read_field_ref fields =
 		let name = self#read_string in
 		try PMap.find name fields with e ->
-			ServerMessage.debug_msg (Printf.sprintf "[%s]  %s reading field %s\n" (s_type_path m.m_path) todo_error name);
-			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
+			print_endline (Printf.sprintf "[%s]  %s reading field %s" (s_type_path m.m_path) todo_error name);
+			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
+			print_stacktrace ();
 			null_field
 
 	method read_enum_field_ref en =
 		let name = self#read_string in
 		try PMap.find name en.e_constrs with e ->
-			ServerMessage.debug_msg (Printf.sprintf "  %s reading enum field ref for %s.%s\n" todo_error (s_type_path en.e_path) name);
-			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
+			print_endline (Printf.sprintf "  %s reading enum field ref for %s.%s" todo_error (s_type_path en.e_path) name);
+			ServerMessage.debug_msg (Printf.sprintf "    Available fields: %s" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
 			null_enum_field
 
 	method read_anon_field_ref =
@@ -210,7 +218,7 @@ class hxb_reader
 		| 0 ->
 			let index = self#read_uleb128 in
 			(try anon_fields.(index) with e ->
-				ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon field (0) ref %i\n" (s_type_path m.m_path) todo_error index);
+				print_endline (Printf.sprintf "[%s] %s reading anon field (0) ref %i" (s_type_path m.m_path) todo_error index);
 				raise e
 			)
 		| 1 ->
@@ -220,7 +228,7 @@ class hxb_reader
 				anon_fields.(index) <- cf;
 				cf
 			end with e ->
-				ServerMessage.debug_msg (Printf.sprintf "[%s] %s reading anon field (1) ref %i\n" (s_type_path m.m_path) todo_error index);
+				print_endline (Printf.sprintf "[%s] %s reading anon field (1) ref %i" (s_type_path m.m_path) todo_error index);
 				raise e
 			)
 		| _ ->
@@ -619,14 +627,14 @@ class hxb_reader
 
 	method read_type_instance =
 		let kind = self#read_u8 in
-		(* Printf.eprintf "   Read type instance %d\n" kind; *)
+		(* ServerMessage.debug_msg (Printf.sprintf "   Read type instance %d" kind); *)
 
 		match kind with
 		| 0 ->
-			(* Printf.eprintf "  %s identity\n" todo; *)
+			(* ServerMessage.debug_msg (Printf.sprintf "  %s identity" todo); *)
 			mk_mono() (* TODO: identity *)
 		| 1 ->
-			(* Printf.eprintf "  %s TMono Some\n" todo; *)
+			(* ServerMessage.debug_msg (Printf.sprintf "  %s TMono Some" todo); *)
 			let t = self#read_type_instance in
 			let tmono = !monomorph_create_ref () in (* TODO identity *)
 			tmono.tm_type <- Some t;
@@ -681,7 +689,7 @@ class hxb_reader
 		| 31 ->
 			let f () =
 				let name = self#read_string in
-				(* Printf.eprintf "  Read type instance for %s\n" name; *)
+				(* ServerMessage.debug_msg (Printf.sprintf "  Read type instance for %s" name); *)
 				let opt = self#read_bool in
 				let t = self#read_type_instance in
 				(name,opt,t)
@@ -691,13 +699,13 @@ class hxb_reader
 		| 32 ->
 			let f () =
 				let name = self#read_string in
-				(* Printf.eprintf "  Read type instance for %s\n" name; *)
+				(* ServerMessage.debug_msg (Printf.sprintf "  Read type instance for %s" name); *)
 				let opt = self#read_bool in
 				let t = self#read_type_instance in
 				(name,opt,t)
 			in
 			let args = self#read_list f in
-			(* Printf.eprintf "  Read type instance for TFun\n"; *)
+			(* ServerMessage.debug_msg (Printf.sprintf "  Read type instance for TFun"); *)
 			let ret = self#read_type_instance in
 			TFun(args,ret)
 		| 33 ->
@@ -725,8 +733,8 @@ class hxb_reader
 		let a = Array.init l (fun _ ->
 			let name = self#read_string in
 			let pos = self#read_pos in
-			(* Printf.eprintf "      Read ttp pos for %s: %s\n" name (Printer.s_pos pos); *)
-			(* Printf.eprintf "      - Path was %s\n" (s_type_path path); *)
+			(* ServerMessage.debug_msg (Printf.sprintf "      Read ttp pos for %s: %s" name (Printer.s_pos pos)); *)
+			(* ServerMessage.debug_msg (Printf.sprintf "      - Path was %s" (s_type_path path)); *)
 			let c = mk_class m (fst path @ [snd path],name) pos pos in
 			mk_type_param name (TInst(c,[])) None
 		) in
@@ -850,7 +858,7 @@ class hxb_reader
 		let pos = self#read_pos in
 
 		let i = IO.read_byte ch in
-		(* Printf.eprintf "      -- texpr [%d] --\n" i; *)
+		(* ServerMessage.debug_msg (Printf.sprintf "      -- texpr [%d] --" i); *)
 		let e = match i with
 			(* values 0-19 *)
 			| 0 -> TConst TNull
@@ -981,7 +989,6 @@ class hxb_reader
 			| 101 ->
 				let e1 = self#read_texpr in
 				let en = self#read_enum_ref in
-				(* PMap.iter (fun k _-> Printf.eprintf "    -> %s\n" k) en.e_constrs; *)
 				let ef = self#read_enum_field_ref en in
 				let i = IO.read_i32 ch in
 				TEnumParameter(e1,ef,i)
@@ -989,13 +996,11 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				(* Printf.eprintf "  Read field ref for expr 102 (cl = %s, %d fields)\n" (s_type_path c.cl_path) (List.length c.cl_ordered_fields); *)
 				let cf = self#read_field_ref c.cl_fields in
 				TField(e1,FInstance(c,tl,cf))
 			| 103 ->
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
-				(* Printf.eprintf "  Read field ref for expr 103 (cl = %s)\n" (s_type_path c.cl_path); *)
 				let cf = self#read_field_ref c.cl_statics in
 				TField(e1,FStatic(c,cf))
 			| 104 ->
@@ -1006,7 +1011,6 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				(* Printf.eprintf "  Read field ref for expr 105 (cl = %s)\n" (s_type_path c.cl_path); *)
 				let cf = self#read_field_ref c.cl_fields in
 				TField(e1,FClosure(Some(c,tl),cf))
 			| 106 ->
@@ -1072,12 +1076,12 @@ class hxb_reader
 			| 250 -> TIdent (self#read_string)
 
 			| i ->
-				ServerMessage.debug_msg (Printf.sprintf "  [ERROR] Unhandled texpr %d at:\n" i);
+				print_endline (Printf.sprintf "  [ERROR] Unhandled texpr %d at:" i);
 				(* MessageReporting.display_source_at com pos; *)
 				assert false
 		in
 
-		(* Printf.eprintf "   Done reading texpr at:\n"; *)
+		(* ServerMessage.debug_msg (Printf.sprintf "   Done reading texpr at:"); *)
 		(* MessageReporting.display_source_at com pos; *)
 
 		{
@@ -1099,7 +1103,7 @@ class hxb_reader
 
 	method read_class_field_data (nested : bool) (cf : tclass_field) : unit =
 		let name = cf.cf_name in
-		(* Printf.eprintf "  Read class field %s\n" name; *)
+		(* ServerMessage.debug_msg (Printf.sprintf "  Read class field %s" name); *)
 		self#read_type_parameters ([],name) (fun a ->
 			field_type_parameters <- if nested then Array.append field_type_parameters a else a
 		);
@@ -1150,8 +1154,8 @@ class hxb_reader
 		| _ ->
 			type_type_parameters <- Array.of_list c.cl_params
 		end;
-		(* Printf.eprintf "  read class fields with type parameters for %s: %d\n" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
-		(* Printf.eprintf "    own class params: %d\n" (List.length c.cl_params); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "  read class fields with type parameters for %s: %d" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "    own class params: %d" (List.length c.cl_params); *)
 		let _ = self#read_option (fun f ->
 			self#read_class_field_data false (Option.get c.cl_constructor)
 		) in
@@ -1169,7 +1173,7 @@ class hxb_reader
 		type_type_parameters <- Array.of_list e.e_params;
 		ignore(self#read_list (fun () ->
 			let name = self#read_string in
-			(* Printf.eprintf "  Read enum field %s\n" name; *)
+			(* ServerMessage.debug_msg (Printf.sprintf "  Read enum field %s" name); *)
 			let ef = PMap.find name e.e_constrs in
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			ef.ef_params <- Array.to_list field_type_parameters;
@@ -1182,7 +1186,7 @@ class hxb_reader
 
 	method read_common_module_type (infos : tinfos) =
 		(* if (snd m.m_path) = "Issue9149" then *)
-		(* Printf.eprintf "[%s] Read module type %s\n" (s_type_path m.m_path) (s_type_path infos.mt_path); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "[%s] Read module type %s" (s_type_path m.m_path) (s_type_path infos.mt_path)); *)
 		infos.mt_private <- self#read_bool;
 		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
 		infos.mt_meta <- self#read_metadata;
@@ -1265,7 +1269,7 @@ class hxb_reader
 
 	method read_string_pool =
 		let l = self#read_uleb128 in
-		(* Printf.eprintf "  Read string pool of size %d\n" l; *)
+		(* ServerMessage.debug_msg (Printf.sprintf "  Read string pool of size %d" l); *)
 		Array.init l (fun i ->
 			self#read_raw_string;
 		);
@@ -1276,7 +1280,7 @@ class hxb_reader
 		let data = IO.nread ch size in
 		let crc = self#read_u32 in
 		ignore(crc); (* TODO *)
-		(* Printf.eprintf "%s check crc (%d)\n" todo (Int32.to_int crc); *)
+		(* ServerMessage.debug_msg (Printf.sprintf "%s check crc (%d)" todo (Int32.to_int crc)); *)
 		let kind = chunk_kind_of_string name in
 		(kind,data)
 
@@ -1401,7 +1405,6 @@ class hxb_reader
 
 	method read_annr =
 		let l = self#read_uleb128 in
-		(* Printf.eprintf "ANNR - %d\n" l; *)
 		anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed });
 
 	method read_typf =
@@ -1424,7 +1427,7 @@ class hxb_reader
 				c.cl_constructor <- self#read_option read_field;
 				c.cl_ordered_fields <- self#read_list read_field;
 				c.cl_ordered_statics <- self#read_list read_field;
-				(* Printf.eprintf "  Forward declare %s with %d fields, %d statics\n" (s_type_path path) (List.length c.cl_ordered_fields) (List.length c.cl_ordered_statics); *)
+				(* ServerMessage.debug_msg (Printf.sprintf "  Forward declare %s with %d fields, %d statics\n" (s_type_path path) (List.length c.cl_ordered_fields) (List.length c.cl_ordered_statics)); *)
 				List.iter (fun cf -> c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields) c.cl_ordered_fields;
 				List.iter (fun cf -> c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics) c.cl_ordered_statics;
 
@@ -1514,7 +1517,7 @@ class hxb_reader
 		let chunks = pass_0 chunks in
 		assert(m != null_module);
 		List.iter (fun (kind,data) ->
-			(* Printf.eprintf " Reading chunk %s\n" (string_of_chunk_kind kind); *)
+			(* ServerMessage.debug_msg (Printf.sprintf " Reading chunk %s" (string_of_chunk_kind kind)); *)
 			ch <- IO.input_bytes data;
 			match kind with
 			| TYPF ->

src/compiler/hxb/hxbWriter.ml

@@ -58,20 +58,25 @@ let unop_index op flag = match op,flag with
 	| NegBits,Postfix -> 10
 	| Spread,Postfix -> 11
 
+let debug_msg msg =
+	(* TODO fix dependency cycle issue *)
+	(* ServerMessage.debug_msg msg *)
+	print_endline msg
+
 let print_stacktrace () =
 	let stack = Printexc.get_callstack 10 in
 	let lines = Printf.sprintf "%s\n" (Printexc.raw_backtrace_to_string stack) in
 	match (ExtString.String.split_on_char '\n' lines) with
-		| (_ :: (_ :: lines)) -> Printf.eprintf "%s" (ExtString.String.join "\n" lines)
+		| (_ :: (_ :: lines)) -> debug_msg (Printf.sprintf "%s" (ExtString.String.join "\n" lines))
 		| _ -> die "" __LOC__
 
 let print_types source tl =
-	Printf.eprintf "Types from %s: \n" source;
-	List.iter (fun t -> Printf.eprintf "  %s\n" (s_type_kind t)) tl
+	debug_msg (Printf.sprintf "Types from %s:" source);
+	List.iter (fun t -> debug_msg (Printf.sprintf "  %s" (s_type_kind t))) tl
 
 let print_params source ttp =
-	Printf.eprintf "Params from %s: \n" source;
-	List.iter (fun t -> Printf.eprintf "  %s\n" t.ttp_name) ttp
+	debug_msg (Printf.sprintf "Params from %s:" source);
+	List.iter (fun t -> debug_msg (Printf.sprintf "  %s" t.ttp_name)) ttp
 
 class ['key,'value] pool = object(self)
 	val lut = Hashtbl.create 0
@@ -274,7 +279,7 @@ class ['a] hxb_writer
 	(* Chunks *)
 
 	method start_chunk (kind : chunk_kind) =
-		(* Printf.eprintf "Writing chunk %s\n" (string_of_chunk_kind kind); *)
+		(* debug_msg (Printf.sprintf "Writing chunk %s" (string_of_chunk_kind kind)); *)
 		let new_chunk = new chunk kind cp in
 		DynArray.add chunks new_chunk;
 		chunk <- new_chunk
@@ -324,22 +329,22 @@ class ['a] hxb_writer
 
 	method write_class_ref (c : tclass) =
 		let i = classes#get_or_add c.cl_path c in
-		(* Printf.eprintf "  Write class ref %d for %s\n" i (snd c.cl_path); *)
+		(* debug_msg (Printf.sprintf "  Write class ref %d for %s" i (snd c.cl_path)); *)
 		chunk#write_uleb128 i
 
 	method write_enum_ref (en : tenum) =
 		let i = enums#get_or_add en.e_path en in
-		(* Printf.eprintf "  Write enum ref %d for %s\n" i (snd en.e_path); *)
+		(* debug_msg (Printf.sprintf "  Write enum ref %d for %s" i (snd en.e_path)); *)
 		chunk#write_uleb128 i
 
 	method write_typedef_ref (td : tdef) =
 		let i = typedefs#get_or_add td.t_path td in
-		(* Printf.eprintf "  Write typedef ref %d for %s\n" i (s_type_path td.t_path); *)
+		(* debug_msg (Printf.sprintf "  Write typedef ref %d for %s" i (s_type_path td.t_path)); *)
 		chunk#write_uleb128 i
 
 	method write_abstract_ref (a : tabstract) =
 		let i = abstracts#get_or_add a.a_path a in
-		(* Printf.eprintf "  Write abstract ref %d for %s\n" i (snd a.a_path); *)
+		(* debug_msg (Printf.sprintf "  Write abstract ref %d for %s" i (snd a.a_path)); *)
 		chunk#write_uleb128 i
 
 	method write_anon_ref (an : tanon) (ttp : type_params) =
@@ -386,9 +391,9 @@ class ['a] hxb_writer
 			chunk#write_byte 7;
 			chunk#write_uleb128 index;
 		with Not_found ->
-			Printf.eprintf "[%s] %s Unbound type parameter %s (%s)\n" (s_type_path current_module.m_path) todo_error (s_type_path c.cl_path) (snd c.cl_path);
-			(* DynArray.iter (fun ttp -> Printf.eprintf "FTP %s %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type)) field_type_parameters#items; *)
-			(* DynArray.iter (fun ttp -> Printf.eprintf "TTP %s %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type)) type_type_parameters#items; *)
+			print_endline (Printf.sprintf "[%s] %s Unbound type parameter %s (%s)" (s_type_path current_module.m_path) todo_error (s_type_path c.cl_path) (snd c.cl_path));
+			(* DynArray.iter (fun ttp -> debug_msg (Printf.sprintf "FTP %s %s" ttp.ttp_name (s_type_kind ttp.ttp_type)) field_type_parameters#items); *)
+			(* DynArray.iter (fun ttp -> debug_msg (Printf.sprintf "TTP %s %s" ttp.ttp_name (s_type_kind ttp.ttp_type)) type_type_parameters#items); *)
 			(* print_stacktrace (); *)
 			chunk#write_byte 40
 		end
@@ -409,7 +414,7 @@ class ['a] hxb_writer
 				self#write_type_instance t
 			end
 		| TInst({cl_kind = KTypeParameter _} as c,[]) ->
-			(* Printf.eprintf "[%s] KTypeParameter for %s\n" (s_type_path current_module.m_path) (s_type_path c.cl_path); *)
+			(* debug_msg (Printf.sprintf "[%s] KTypeParameter for %s" (s_type_path current_module.m_path) (s_type_path c.cl_path)); *)
 			self#write_type_parameter_ref c
 		| TInst({cl_kind = KExpr e},[]) ->
 			chunk#write_byte 8;
@@ -848,7 +853,7 @@ class ['a] hxb_writer
 	method write_texpr (e : texpr) =
 		let rec loop e =
 			(try self#write_type_instance e.etype; with _ -> begin
-				Printf.eprintf "Error while writing type instance for:\n";
+				print_endline (Printf.sprintf "Error while writing type instance for:");
 				(* MessageReporting.display_source_at com e.epos; *)
 			end);
 			self#write_pos e.epos;
@@ -1009,7 +1014,7 @@ class ['a] hxb_writer
 				self#write_enum_field_ref ef;
 				chunk#write_i32 i;
 			| TEnumParameter(e1,({ ef_type = eft}),i) ->
-				Printf.eprintf "en = %s\n" (s_type_kind eft);
+				print_endline (Printf.sprintf "en = %s" (s_type_kind eft));
 				assert false
 			| TField(e1,FInstance(c,tl,cf)) ->
 				chunk#write_byte 102;
@@ -1181,9 +1186,9 @@ class ['a] hxb_writer
 	method write_class_field_data cf =
 		let restore = self#start_temporary_chunk in
 		(* if (snd current_module.m_path) = "Main" then *)
-		(* 	Printf.eprintf " (1) Write class field %s\n" cf.cf_name; *)
+		(* 	debug_msg (Printf.sprintf " (1) Write class field %s" cf.cf_name); *)
 		(try self#write_type_instance cf.cf_type with e -> begin
-			Printf.eprintf "%s while writing type instance for field %s\n" todo_error cf.cf_name;
+			print_endline (Printf.sprintf "%s while writing type instance for field %s" todo_error cf.cf_name);
 			(* raise e *)
 		end);
 		chunk#write_i32 cf.cf_flags;
@@ -1191,7 +1196,7 @@ class ['a] hxb_writer
 		self#write_metadata cf.cf_meta;
 		self#write_field_kind cf.cf_kind;
 		(try chunk#write_option cf.cf_expr self#write_texpr with e -> begin
-			Printf.eprintf "%s while writing expr for field %s\n" todo_error cf.cf_name;
+			print_endline (Printf.sprintf "%s while writing expr for field %s" todo_error cf.cf_name);
 			(* MessageReporting.display_source_at com cf.cf_pos; *)
 			(* raise e *)
 		end);
@@ -1215,7 +1220,7 @@ class ['a] hxb_writer
 	(* Module types *)
 
 	method select_type (path : path) =
-		(* Printf.eprintf "Select type %s\n" (s_type_path path); *)
+		(* debug_msg (Printf.sprintf "Select type %s" (s_type_path path)); *)
 		type_type_parameters <- type_param_lut#extract path
 
 	method write_common_module_type (infos : tinfos) : unit =
@@ -1259,13 +1264,13 @@ class ['a] hxb_writer
 	method write_class (c : tclass) =
 		begin match c.cl_kind with
 		| KAbstractImpl a ->
-			(* Printf.eprintf "Write abstract impl %s with %d type params\n" (snd c.cl_path) (List.length a.a_params); *)
+			(* debug_msg (Printf.sprintf "Write abstract impl %s with %d type params" (snd c.cl_path) (List.length a.a_params)); *)
 			self#select_type a.a_path
 		| _ ->
 			self#select_type c.cl_path;
 		end;
 		(* if (snd current_module.m_path) = "Bar_String" then *)
-		(* Printf.eprintf "[%s] Write class %s with %d type params\n" (s_type_path current_module.m_path) (snd c.cl_path) (List.length c.cl_params); *)
+		(* debug_msg (Printf.sprintf "[%s] Write class %s with %d type params" (s_type_path current_module.m_path) (snd c.cl_path) (List.length c.cl_params)); *)
 		self#write_common_module_type (Obj.magic c);
 		self#write_class_kind c.cl_kind;
 		chunk#write_u32 (Int32.of_int c.cl_flags);
@@ -1322,14 +1327,14 @@ class ['a] hxb_writer
 		chunk#write_bool a.a_enum
 
 	method write_enum (e : tenum) =
-		(* Printf.eprintf "Write enum %s\n" (snd e.e_path); *)
+		(* debug_msg (Printf.sprintf "Write enum %s" (snd e.e_path)); *)
 		self#select_type e.e_path;
 		self#write_common_module_type (Obj.magic e);
 		chunk#write_bool e.e_extern;
 		chunk#write_list e.e_names chunk#write_string;
 
 	method write_typedef (td : tdef) =
-		(* Printf.eprintf "Write typedef %s %s >>\n" (s_type_path td.t_path) (s_type_kind td.t_type); *)
+		(* debug_msg (Printf.sprintf "Write typedef %s %s >>" (s_type_path td.t_path) (s_type_kind td.t_type)); *)
 		self#select_type td.t_path;
 		self#write_common_module_type (Obj.magic td);
 		self#write_type_instance td.t_type;
@@ -1398,7 +1403,7 @@ class ['a] hxb_writer
 		in
 
 		let infos = t_infos mt in
-		(* Printf.eprintf "Forward declare type %s\n" (s_type_path infos.mt_path); *)
+		(* debug_msg (Printf.sprintf "Forward declare type %s" (s_type_path infos.mt_path)); *)
 		chunk#write_byte i;
 		(* self#write_path infos.mt_path; *)
 		self#write_full_path (fst infos.mt_path) (snd infos.mt_path) !name;
@@ -1427,7 +1432,7 @@ class ['a] hxb_writer
 			| _ -> assert false);
 
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
-				(* Printf.eprintf "  forward declare enum field %s.%s\n" (s_type_path e.e_path) s; *)
+				(* debug_msg (Printf.sprintf "  forward declare enum field %s.%s" (s_type_path e.e_path) s); *)
 				chunk#write_string s;
 				self#write_pos ef.ef_pos;
 				self#write_pos ef.ef_name_pos;
@@ -1447,8 +1452,8 @@ class ['a] hxb_writer
 		chunk#write_list m.m_types self#forward_declare_type;
 
 		(* if (snd current_module.m_path) = "Issue3090" then *)
-		(* Printf.eprintf "Write module %s with %d own classes, %d own abstracts, %d own enums, %d own typedefs\n" *)
-		(* 	(snd m.m_path) (List.length own_classes#to_list) (List.length own_abstracts#to_list) (List.length own_enums#to_list) (List.length own_typedefs#to_list); *)
+		(* debug_msg (Printf.sprintf "Write module %s with %d own classes, %d own abstracts, %d own enums, %d own typedefs" *)
+		(* 	(snd m.m_path) (List.length own_classes#to_list) (List.length own_abstracts#to_list) (List.length own_enums#to_list) (List.length own_typedefs#to_list)); *)
 
 		begin match own_abstracts#to_list with
 		| [] ->
@@ -1495,7 +1500,7 @@ class ['a] hxb_writer
 			chunk#write_list own_enums (fun e ->
 				chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
 					self#select_type e.e_path;
-					(* Printf.eprintf "  Write enum field %s.%s\n" (s_type_path e.e_path) s; *)
+					(* debug_msg (Printf.sprintf "  Write enum field %s.%s" (s_type_path e.e_path) s); *)
 					chunk#write_string s;
 					self#set_field_type_parameters ef.ef_params;
 					chunk#write_list ef.ef_params self#write_type_parameter_forward;
@@ -1544,7 +1549,7 @@ class ['a] hxb_writer
 			self#start_chunk CLSR;
 			chunk#write_list l (fun c ->
 				let m = c.cl_module in
-				(* Printf.eprintf "  [cls] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd c.cl_path)])); *)
+				(* debug_msg (Printf.sprintf "  [cls] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd c.cl_path)]))); *)
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd c.cl_path)
 			)
 		end;
@@ -1555,7 +1560,7 @@ class ['a] hxb_writer
 			self#start_chunk ABSR;
 			chunk#write_list l (fun a ->
 				let m = a.a_module in
-				(* Printf.eprintf "  [abs] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd a.a_path)])); *)
+				(* debug_msg (Printf.sprintf "  [abs] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd a.a_path)]))); *)
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd a.a_path)
 			)
 		end;
@@ -1566,7 +1571,7 @@ class ['a] hxb_writer
 			self#start_chunk ENMR;
 			chunk#write_list l (fun en ->
 				let m = en.e_module in
-				(* Printf.eprintf "  [enm] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd en.e_path)])); *)
+				(* debug_msg (Printf.sprintf "  [enm] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd en.e_path)]))); *)
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd en.e_path)
 			)
 		end;
@@ -1577,7 +1582,7 @@ class ['a] hxb_writer
 			self#start_chunk TPDR;
 			chunk#write_list l (fun td ->
 				let m = td.t_module in
-				(* Printf.eprintf "  [tpdr] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd td.t_path)])); *)
+				(* debug_msg (Printf.sprintf "  [tpdr] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd td.t_path)]))); *)
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd td.t_path)
 			)
 		end;

src/filters/filters.ml

@@ -722,6 +722,7 @@ let destruction tctx detail_times main locals =
 		) com.types;
 	);
 	com.stage <- CDceStart;
+	ServerMessage.compiler_stage com;
 	with_timer detail_times "dce" None (fun () ->
 		(* DCE *)
 		let dce_mode = try Common.defined_value com Define.Dce with _ -> "no" in
@@ -734,6 +735,7 @@ let destruction tctx detail_times main locals =
 		Dce.run com main dce_mode;
 	);
 	com.stage <- CDceDone;
+	ServerMessage.compiler_stage com;
 	(* PASS 3: type filters post-DCE *)
 	List.iter
 		(run_expression_filters
@@ -772,7 +774,8 @@ let destruction tctx detail_times main locals =
 		) com.types;
 	);
 	com.callbacks#run com.error_ext com.callbacks#get_after_filters;
-	com.stage <- CFilteringDone
+	com.stage <- CFilteringDone;
+	ServerMessage.compiler_stage com
 
 let update_cache_dependencies com t =
 	let visited_anons = ref [] in
@@ -938,6 +941,7 @@ let run tctx main =
 		end;
 		not cached
 	) com.types in
+	ServerMessage.debug_msg (Printf.sprintf "%d new types\n" (List.length new_types));
 	(* IMPORTANT:
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 		because they received an additional dependency. This could happen in cases such as @:generic methods in #10635.
@@ -995,8 +999,10 @@ let run tctx main =
 		List.iter (fun f -> List.iter f new_types) filters;
 	);
 	com.stage <- CAnalyzerStart;
+	ServerMessage.compiler_stage com;
 	if com.platform <> Cross then Analyzer.Run.run_on_types com new_types;
 	com.stage <- CAnalyzerDone;
+	ServerMessage.compiler_stage com;
 	let locals = RenameVars.init com in
 	let filters = [
 		"sanitize",Optimizer.sanitize com;
@@ -1012,6 +1018,7 @@ let run tctx main =
 		com.callbacks#run com.error_ext com.callbacks#get_before_save;
 	);
 	com.stage <- CSaveStart;
+	ServerMessage.compiler_stage com;
 	with_timer detail_times "save state" None (fun () ->
 		List.iter (fun mt ->
 			update_cache_dependencies com mt;
@@ -1019,6 +1026,7 @@ let run tctx main =
 		) new_types;
 	);
 	com.stage <- CSaveDone;
+	ServerMessage.compiler_stage com;
 	with_timer detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_after_save;
 	);

src/typing/typeloadCheck.ml

@@ -324,9 +324,8 @@ let check_module_types ctx m p t =
 		let hex1 = Digest.to_hex m.m_extra.m_sign in
 		let hex2 = Digest.to_hex m2.m_extra.m_sign in
 		let s = if hex1 = hex2 then hex1 else Printf.sprintf "was %s, is %s" hex2 hex1 in
-		(* raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p *)
+		raise_typing_error (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p
 		(* ctx.com.warning WInfo [] (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s) p; *)
-		print_endline (Printf.sprintf "Type name %s is redefined from module %s (%s)" (s_type_path t.mt_path)  (s_type_path path2) s);
 	with
 		Not_found ->
 			ctx.com.type_to_module#add t.mt_path m.m_path