[analyzer] support -D analyzer-times=level

0 = nothing, 1 = pass names, 2 = function names

src-json/define.json

@@ -15,6 +15,12 @@
 		"define": "analyzer-optimize",
 		"doc": "Perform advanced optimizations."
 	},
+	{
+		"name": "AnalyzerTimes",
+		"define": "analyzer-times",
+		"doc": "Record detailed timers for the analyzer",
+		"params": ["level: 0 | 1 | 2"]
+	},
 	{
 		"name": "AnnotateSource",
 		"define": "annotate-source",

src/context/typecore.ml

@@ -208,7 +208,7 @@ let type_expr_ref : (?mode:access_mode -> typer -> expr -> WithType.t -> texpr)
 let type_block_ref : (typer -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ -> die "" __LOC__)
 let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> die "" __LOC__)
 let unify_min_for_type_source_ref : (typer -> texpr list -> WithType.with_type_source option -> t) ref = ref (fun _ _ _ -> die "" __LOC__)
-let analyzer_run_on_expr_ref : (Common.context -> texpr -> texpr) ref = ref (fun _ _ -> die "" __LOC__)
+let analyzer_run_on_expr_ref : (Common.context -> string -> texpr -> texpr) ref = ref (fun _ _ _ -> die "" __LOC__)
 let cast_or_unify_raise_ref : (typer -> ?uctx:unification_context option -> Type.t -> texpr -> pos -> texpr) ref = ref (fun _ ?uctx _ _ _ -> assert false)
 let type_generic_function_ref : (typer -> field_access -> (unit -> texpr) field_call_candidate -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> assert false)
 

src/optimization/analyzer.ml

@@ -933,13 +933,20 @@ module Run = struct
 	open AnalyzerConfig
 	open Graph
 
-	let with_timer detailed s f =
-		let timer = Timer.timer (if detailed then "analyzer" :: s else ["analyzer"]) in
+	let with_timer level identifier s f =
+		let name = match level with
+			| 0 -> ["analyzer"]
+			| 1 -> "analyzer" :: s
+			| 2 when identifier = "" -> "analyzer" :: s
+			| 2 -> "analyzer" :: s @ [identifier]
+			| _ -> ["analyzer"] (* whatever *)
+		in
+		let timer = Timer.timer name in
 		let r = f() in
 		timer();
 		r
 
-	let create_analyzer_context com config e =
+	let create_analyzer_context com config identifier e =
 		let g = Graph.create e.etype e.epos in
 		let ctx = {
 			com = com;
@@ -949,8 +956,9 @@ module Run = struct
 			   avoid problems with the debugger, see https://github.com/HaxeFoundation/hxcpp/issues/365 *)
 			temp_var_name = (match com.platform with Cpp -> "_hx_tmp" | _ -> "tmp");
 			with_timer = (fun s f ->
-				with_timer config.detail_times s f
+				with_timer config.detail_times identifier s f
 			);
+			identifier = identifier;
 			entry = g.g_unreachable;
 			has_unbound = false;
 			loop_counter = 0;
@@ -1063,7 +1071,7 @@ module Run = struct
 	let run_on_field com config c cf = match cf.cf_expr with
 		| Some e when not (is_ignored cf.cf_meta) && not (Typecore.is_removable_field com cf) && not (has_class_field_flag cf CfPostProcessed) ->
 			let config = update_config_from_meta com config cf.cf_meta in
-			let actx = create_analyzer_context com config e in
+			let actx = create_analyzer_context com config (Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name) e in
 			let debug() =
 				print_endline (Printf.sprintf "While analyzing %s.%s" (s_type_path c.cl_path) cf.cf_name);
 				List.iter (fun (s,e) ->
@@ -1116,7 +1124,7 @@ module Run = struct
 			| Some e ->
 				let tf = { tf_args = []; tf_type = e.etype; tf_expr = e; } in
 				let e = mk (TFunction tf) (tfun [] e.etype) e.epos in
-				let actx = create_analyzer_context com {config with optimize = false} e in
+				let actx = create_analyzer_context com {config with optimize = false} (Printf.sprintf "%s.__init__" (s_type_path c.cl_path)) e in
 				let e = run_on_expr actx e in
 				let e = match e.eexpr with
 					| TFunction tf -> tf.tf_expr
@@ -1135,18 +1143,18 @@ module Run = struct
 
 	let run_on_types com types =
 		let config = get_base_config com in
-		with_timer config.detail_times ["other"] (fun () ->
+		with_timer config.detail_times "" ["other"] (fun () ->
 			if config.optimize && config.purity_inference then
-				with_timer config.detail_times ["optimize";"purity-inference"] (fun () -> Purity.infer com);
+				with_timer config.detail_times "" ["optimize";"purity-inference"] (fun () -> Purity.infer com);
 			List.iter (run_on_type com config) types
 		)
 end
 ;;
-Typecore.analyzer_run_on_expr_ref := (fun com e ->
+Typecore.analyzer_run_on_expr_ref := (fun com identifier e ->
 	let config = AnalyzerConfig.get_base_config com in
 	(* We always want to optimize because const propagation might be required to obtain
 	   a constant expression for inline field initializations (see issue #4977). *)
 	let config = {config with AnalyzerConfig.optimize = true} in
-	let actx = Run.create_analyzer_context com config e in
+	let actx = Run.create_analyzer_context com config identifier e in
 	Run.run_on_expr actx e
 )

src/optimization/analyzerConfig.ml

@@ -35,7 +35,7 @@ type t = {
 	fusion : bool;
 	purity_inference : bool;
 	debug_kind : debug_kind;
-	detail_times : bool;
+	detail_times : int;
 	user_var_fusion : bool;
 	fusion_debug : bool;
 }
@@ -71,7 +71,7 @@ let get_base_config com =
 		fusion = not (Common.raw_defined com "analyzer_no_fusion");
 		purity_inference = not (Common.raw_defined com "analyzer_no_purity_inference");
 		debug_kind = DebugNone;
-		detail_times = Common.raw_defined com "analyzer_times";
+		detail_times = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.AnalyzerTimes) with _ -> 0);
 		user_var_fusion = (match com.platform with Flash | Java -> false | _ -> true) && (Common.raw_defined com "analyzer_user_var_fusion" || (not com.debug && not (Common.raw_defined com "analyzer_no_user_var_fusion")));
 		fusion_debug = false;
 	}

src/optimization/analyzerTypes.ml

@@ -595,6 +595,7 @@ type analyzer_context = {
 	graph : Graph.t;
 	temp_var_name : string;
 	with_timer : 'a . string list -> (unit -> 'a) -> 'a;
+	identifier : string;
 	mutable entry : BasicBlock.t;
 	mutable has_unbound : bool;
 	mutable loop_counter : int;

src/typing/typeloadFields.ml

@@ -853,7 +853,7 @@ module TypeBinding = struct
 				let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in
 				let maybe_run_analyzer e = match e.eexpr with
 					| TConst _ | TLocal _ | TFunction _ -> e
-					| _ -> !analyzer_run_on_expr_ref ctx.com e
+					| _ -> !analyzer_run_on_expr_ref ctx.com (Printf.sprintf "%s.%s" (s_type_path cctx.tclass.cl_path) cf.cf_name) e
 				in
 				let require_constant_expression e msg =
 					match Optimizer.make_constant_expression ctx (maybe_run_analyzer e) with