فهرست منبع

[typer] collect pass debug messages and print them in JSON output

Simon Krajewski 6 سال پیش
والد
کامیت
91fcc0d142
3فایلهای تغییر یافته به همراه14 افزوده شده و 2 حذف شده
  1. 2 0
      src/context/common.ml
  2. 5 0
      src/context/display/displayJson.ml
  3. 7 2
      src/context/typecore.ml

+ 2 - 0
src/context/common.ml

@@ -188,6 +188,7 @@ type context = {
 	module_to_file : (path,string) Hashtbl.t;
 	cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) Hashtbl.t;
 	mutable stored_typed_exprs : (int, texpr) PMap.t;
+	pass_debug_messages : string DynArray.t;
 	(* output *)
 	mutable file : string;
 	mutable flash_version : float;
@@ -442,6 +443,7 @@ let create version s_version args =
 		get_macros = (fun() -> None);
 		warning = (fun _ _ -> assert false);
 		error = (fun _ _ -> assert false);
+		pass_debug_messages = DynArray.create();
 		basic = {
 			tvoid = m;
 			tint = m;

+ 5 - 0
src/context/display/displayJson.ml

@@ -249,6 +249,11 @@ let parse_input com input report_times =
 			| Some jo -> ("timers",jo) :: fl
 			end
 		end else fl in
+		let fl = if DynArray.length com.pass_debug_messages > 0 then
+			("passMessages",jarray (List.map jstring (DynArray.to_list com.pass_debug_messages))) :: fl
+		else
+			fl
+		in
 		let jo = jobject fl in
 		send_json (JsonRpc.result jsonrpc#get_id  jo)
 	in

+ 7 - 2
src/context/typecore.ml

@@ -429,7 +429,7 @@ let merge_core_doc ctx mt =
 			| Some ({cf_doc = None} as cf),Some cf2 -> cf.cf_doc <- cf2.cf_doc
 			| _ -> ()
 		end
-	| _ -> ());
+	| _ -> ())
 
 (* -------------- debug functions to activate when debugging typer passes ------------------------------- *)
 (*/*
@@ -445,7 +445,12 @@ let context_ident ctx =
 		"  out "
 
 let debug ctx str =
-	if Common.raw_defined ctx.com "cdebug" then print_endline (context_ident ctx ^ string_of_int (String.length !delay_tabs) ^ " " ^ !delay_tabs ^ str)
+	if Common.raw_defined ctx.com "cdebug" then begin
+		let s = (context_ident ctx ^ string_of_int (String.length !delay_tabs) ^ " " ^ !delay_tabs ^ str) in
+		match ctx.com.json_out with
+		| None -> print_endline s
+		| Some _ -> DynArray.add ctx.com.pass_debug_messages s
+	end
 
 let init_class_done ctx =
 	debug ctx ("init_class_done " ^ s_type_path ctx.curclass.cl_path);