Browse Source

[typecore] update commented out debug code

Rudy Ges 2 years ago
parent
commit
101a188771
1 changed files with 25 additions and 25 deletions
  1. 25 25
      src/context/typecore.ml

+ 25 - 25
src/context/typecore.ml

@@ -743,24 +743,24 @@ let create_deprecation_context ctx = {
 
 
 let delay_tabs = ref ""
 let delay_tabs = ref ""
 
 
-let context_ident ctx =
-	if Common.defined ctx.com Common.Define.CoreApi then
+let context_ident com =
+	if Common.defined com Common.Define.CoreApi then
 		" core "
 		" core "
-	else if Common.defined ctx.com Common.Define.Macro then
+	else if Common.defined com Common.Define.Macro then
 		"macro "
 		"macro "
 	else
 	else
 		"  out "
 		"  out "
 
 
-let debug ctx 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
+let debug com 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
 		| None -> print_endline s
-		| Some _ -> DynArray.add ctx.com.pass_debug_messages s
+		| Some _ -> DynArray.add com.pass_debug_messages s
 	end
 	end
 
 
 let init_class_done ctx =
 let init_class_done ctx =
-	debug ctx ("init_class_done " ^ s_type_path ctx.curclass.cl_path);
+	debug ctx.com ("init_class_done " ^ s_type_path ctx.curclass.cl_path);
 	init_class_done ctx
 	init_class_done ctx
 
 
 let ctx_pos ctx =
 let ctx_pos ctx =
@@ -787,7 +787,7 @@ let delay ctx p f =
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 	in
 	in
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
-	debug ctx ("add " ^ inf)
+	debug ctx.com ("add " ^ inf)
 
 
 let delay_late ctx p f =
 let delay_late ctx p f =
 	let inf = pass_infos ctx p in
 	let inf = pass_infos ctx p in
@@ -800,7 +800,7 @@ let delay_late ctx p f =
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 				(p,[f,inf,ctx]) :: (p2,l) :: rest
 	in
 	in
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
 	ctx.g.debug_delayed <- loop ctx.g.debug_delayed;
-	debug ctx ("add late " ^ inf)
+	debug ctx.com ("add late " ^ inf)
 
 
 let pending_passes ctx =
 let pending_passes ctx =
 	let rec loop acc = function
 	let rec loop acc = function
@@ -811,28 +811,28 @@ let pending_passes ctx =
 	| [] -> ""
 	| [] -> ""
 	| l -> " ??PENDING[" ^ String.concat ";" (List.map (fun (_,i,_) -> i) l) ^ "]"
 	| l -> " ??PENDING[" ^ String.concat ";" (List.map (fun (_,i,_) -> i) l) ^ "]"
 
 
-let display_error ctx.com msg p =
-	debug ctx ("ERROR " ^ msg);
-	display_error ctx.com msg p
+let display_error com ?(depth=0) msg p =
+	debug com ("ERROR " ^ msg);
+	display_error com ~depth msg p
 
 
-let display_error_ext ctx.com msg =
-	debug ctx ("ERROR " ^ msg);
-	display_error_ext ctx.com msg
+let display_error_ext com err =
+	debug com ("ERROR " ^ (error_msg err.err_message));
+	display_error_ext com err
 
 
 let make_pass ?inf ctx f =
 let make_pass ?inf ctx f =
 	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
 	let inf = (match inf with None -> pass_infos ctx ctx.pass | Some inf -> inf) in
 	(fun v ->
 	(fun v ->
-		debug ctx ("run " ^ inf ^ pending_passes ctx);
+		debug ctx.com ("run " ^ inf ^ pending_passes ctx);
 		let old = !delay_tabs in
 		let old = !delay_tabs in
 		delay_tabs := !delay_tabs ^ "\t";
 		delay_tabs := !delay_tabs ^ "\t";
 		let t = (try
 		let t = (try
 			f v
 			f v
 		with
 		with
-			| Fatal_error (e,p) ->
+			| Fatal_error _ as exc ->
 				delay_tabs := old;
 				delay_tabs := old;
-				raise (Fatal_error (e,p))
+				raise exc
 			| exc when not (Common.raw_defined ctx.com "stack") ->
 			| exc when not (Common.raw_defined ctx.com "stack") ->
-				debug ctx ("FATAL " ^ Printexc.to_string exc);
+				debug ctx.com ("FATAL " ^ Printexc.to_string exc);
 				delay_tabs := old;
 				delay_tabs := old;
 				raise exc
 				raise exc
 		) in
 		) in
@@ -859,11 +859,11 @@ let rec flush_pass ctx p where =
 	match ctx.g.debug_delayed with
 	match ctx.g.debug_delayed with
 	| (p2,_) :: _ when p2 <= p ->
 	| (p2,_) :: _ when p2 <= p ->
 		let old = !delay_tabs in
 		let old = !delay_tabs in
-		debug ctx ("flush " ^ pass_name p ^ "(" ^ where ^ ")");
+		debug ctx.com ("flush " ^ pass_name p ^ "(" ^ where ^ ")");
 		delay_tabs := !delay_tabs ^ "\t";
 		delay_tabs := !delay_tabs ^ "\t";
 		loop();
 		loop();
 		delay_tabs := old;
 		delay_tabs := old;
-		debug ctx "flush-done";
+		debug ctx.com "flush-done";
 	| _ ->
 	| _ ->
 		()
 		()
 
 
@@ -878,8 +878,8 @@ let exc_protect ?(force=true) ctx f (where:string) =
 			r := lazy_available t;
 			r := lazy_available t;
 			t
 			t
 		with
 		with
-			| Error (m,p,depth) ->
-				raise (Fatal_error ((error_msg m),p,depth))
+			| Error e ->
+				raise (Fatal_error e)
 	));
 	));
 	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
 	if force then delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 	r