Merge branch 'development' into safe_com

# Conflicts:
#	src/filters/filterContext.ml
#	src/filters/filters.ml
#	src/typing/macroContext.ml

src/codegen/genxml.ml

@@ -288,15 +288,18 @@ let rec write_xml ch tabs x =
 		IO.printf ch "<![CDATA[%s]]>" s
 
 let generate com file =
-	let t = Timer.timer ["generate";"xml"] in
-	let x = node "haxe" [] (List.map (gen_type_decl com true) (List.filter (fun t -> not (Meta.has Meta.NoDoc (t_infos t).mt_meta)) com.types)) in
-	t();
-	let t = Timer.timer ["write";"xml"] in
-	let ch = IO.output_channel (open_out_bin file) in
-	IO.printf ch "<!-- This file can be parsed by haxe.rtti.XmlParser -->\n";
-	write_xml ch "" x;
-	IO.close_out ch;
-	t()
+	let f () =
+		node "haxe" [] (List.map (gen_type_decl com true) (List.filter (fun t -> not (Meta.has Meta.NoDoc (t_infos t).mt_meta)) com.types))
+	in
+	let x = Timer.time com.timer_ctx ["generate";"xml"] f () in
+
+	let f () =
+		let ch = IO.output_channel (open_out_bin file) in
+		IO.printf ch "<!-- This file can be parsed by haxe.rtti.XmlParser -->\n";
+		write_xml ch "" x;
+		IO.close_out ch;
+	in
+	Timer.time com.timer_ctx ["write";"xml"] f ()
 
 let gen_type_string ctx t =
 	let x = gen_type_decl ctx false t in

src/codegen/javaModern.ml

@@ -1018,7 +1018,7 @@ module Converter = struct
 		(pack,types)
 end
 
-class java_library_modern com name file_path = object(self)
+class java_library_modern com  name file_path = object(self)
 	inherit [java_lib_type,unit] native_library name file_path as super
 
 
@@ -1028,35 +1028,36 @@ class java_library_modern com name file_path = object(self)
 	val mutable loaded = false
 	val mutable closed = false
 
+	method private do_load =
+		List.iter (function
+		| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" ->
+			let pack = String.nsplit filename "/" in
+			begin match List.rev pack with
+				| [] -> ()
+				| name :: pack ->
+					let name = String.sub name 0 (String.length name - 6) in
+					let pack = List.rev pack in
+					let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in
+					let path = PathConverter.jpath_to_path (pack,(mname,tname)) in
+					let mname = match mname with
+						| None ->
+							cached_files <- path :: cached_files;
+							tname
+						| Some mname -> mname
+					in
+					Hashtbl.add modules (pack,mname) (filename,entry);
+				end
+		| _ -> ()
+	) (Zip.entries (Lazy.force zip));
+
 	method load =
 		if not loaded then begin
 			loaded <- true;
-			let close = Timer.timer ["jar";"load"] in
-			List.iter (function
-				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" ->
-					let pack = String.nsplit filename "/" in
-					begin match List.rev pack with
-						| [] -> ()
-						| name :: pack ->
-							let name = String.sub name 0 (String.length name - 6) in
-							let pack = List.rev pack in
-							let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in
-							let path = PathConverter.jpath_to_path (pack,(mname,tname)) in
-							let mname = match mname with
-								| None ->
-									cached_files <- path :: cached_files;
-									tname
-								| Some mname -> mname
-							in
-							Hashtbl.add modules (pack,mname) (filename,entry);
-						end
-				| _ -> ()
-			) (Zip.entries (Lazy.force zip));
-			close();
+			Timer.time com.Common.timer_ctx ["jar";"load"] (fun () -> self#do_load) ()
 		end
 
 	method private read zip (filename,entry) =
-		Std.finally (Timer.timer ["jar";"read"]) (fun () ->
+		Timer.time com.Common.timer_ctx ["jar";"read"] (fun () ->
 			let data = Zip.read_entry zip entry in
 			let jc = JReaderModern.parse_class (IO.input_string data) in
 			(jc,file_path,file_path ^ "@" ^ filename)
@@ -1084,7 +1085,7 @@ class java_library_modern com name file_path = object(self)
 					if entries = [] then raise Not_found;
 					let zip = Lazy.force zip in
 					let jcs = List.map (self#read zip) entries in
-					Std.finally (Timer.timer ["jar";"convert"]) (fun () ->
+					Timer.time com.Common.timer_ctx ["jar";"convert"] (fun () ->
 						Some (Converter.convert_module (fst path) jcs)
 					) ();
 				with Not_found ->

src/codegen/swfLoader.ml

@@ -456,7 +456,6 @@ let build_class com c file =
 	(path.tpackage, [(EClass class_data,pos)])
 
 let extract_data (_,tags) =
-	let t = Timer.timer ["read";"swf"] in
 	let h = Hashtbl.create 0 in
 	let loop_field f =
 		match f.hlf_kind with
@@ -474,9 +473,11 @@ let extract_data (_,tags) =
 			List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
 		| _ -> ()
 	) tags;
-	t();
 	h
 
+let extract_data com arg =
+	Timer.time com.timer_ctx ["read";"swf"] extract_data arg
+
 let remove_debug_infos as3 =
 	let hl = As3hlparse.parse as3 in
 	let methods = Hashtbl.create 0 in
@@ -547,8 +548,7 @@ let remove_debug_infos as3 =
 	in
 	As3hlparse.flatten (List.map loop_static hl)
 
-let parse_swf com file =
-	let t = Timer.timer ["read";"swf"] in
+let parse_swf file =
 	let is_swc = Path.file_extension file = "swc" || Path.file_extension file = "ane" in
 	let ch = if is_swc then begin
 		let zip = Zip.open_in file in
@@ -577,9 +577,11 @@ let parse_swf com file =
 			t.tdata <- TActionScript3 (id,remove_debug_infos as3)
 		| _ -> ()
 	) tags;
-	t();
 	(h,tags)
 
+let parse_swf com file =
+	Timer.time com.timer_ctx ["read";"swf"] parse_swf file
+
 class swf_library com name file_path = object(self)
 	inherit [swf_lib_type,Swf.swf] native_library name file_path
 
@@ -600,7 +602,7 @@ class swf_library com name file_path = object(self)
 
 	method extract = match swf_classes with
 		| None ->
-			let d = extract_data self#get_swf in
+			let d = extract_data com self#get_swf in
 			swf_classes <- Some d;
 			d
 		| Some d ->

src/compiler/args.ml

@@ -261,7 +261,7 @@ let parse_args com =
 			actx.hxb_out <- Some file;
 		),"<file>", "generate haxe binary representation to target archive");
 		("Optimization",["--no-output"],[], Arg.Unit (fun() -> actx.no_output <- true),"","compiles but does not generate any file");
-		("Debug",["--times"],[], Arg.Unit (fun() -> Timer.measure_times := true),"","measure compilation times");
+		("Debug",["--times"],[], Arg.Unit (fun() -> com.timer_ctx.measure_times <- true),"","measure compilation times");
 		("Optimization",["--no-inline"],[],Arg.Unit (fun () ->
 			add_deprecation "--no-inline has been deprecated, use -D no-inline instead";
 			Common.define com Define.NoInline

src/compiler/compilationCache.ml

@@ -140,8 +140,7 @@ class virtual server_task (id : string list) (priority : int) = object(self)
 	method private virtual execute : unit
 
 	method run : unit =
-		let t = Timer.timer ("server" :: "task" :: id) in
-		Std.finally t (fun () -> self#execute) ()
+		self#execute
 
 	method get_priority = priority
 	method get_id = id

src/compiler/compilationContext.ml

@@ -43,7 +43,7 @@ type communication = {
 	write_out : string -> unit;
 	write_err : string -> unit;
 	flush     : compilation_context -> unit;
-	exit      : int -> unit;
+	exit      : Timer.timer_context -> int -> unit;
 	is_server : bool;
 }
 
@@ -54,6 +54,7 @@ and compilation_context = {
 	mutable has_error : bool;
 	comm : communication;
 	mutable runtime_args : string list;
+	timer_ctx : Timer.timer_context;
 }
 
 type compilation_callbacks = {

src/compiler/compiler.ml

@@ -33,7 +33,6 @@ let run_or_diagnose ctx f =
 		f ()
 
 let run_command ctx cmd =
-	let t = Timer.timer ["command";cmd] in
 	(* TODO: this is a hack *)
 	let cmd = if ctx.comm.is_server then begin
 		let h = Hashtbl.create 0 in
@@ -72,9 +71,11 @@ let run_command ctx cmd =
 			result
 		end
 	in
-	t();
 	result
 
+let run_command ctx cmd =
+	Timer.time ctx.timer_ctx ["command";cmd] (run_command ctx) cmd
+
 module Setup = struct
 	let initialize_target ctx com actx =
 		init_platform com;
@@ -286,7 +287,6 @@ let check_defines com =
 (** Creates the typer context and types [classes] into it. *)
 let do_type ctx mctx actx display_file_dot_path =
 	let com = ctx.com in
-	let t = Timer.timer ["typing"] in
 	let cs = com.cs in
 	CommonCache.maybe_add_context_sign cs com "before_init_macros";
 	enter_stage com CInitMacrosStart;
@@ -327,11 +327,9 @@ let do_type ctx mctx actx display_file_dot_path =
 		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
 		| _ -> ()
 	end;
-	t();
 	(tctx, display_file_dot_path)
 
 let finalize_typing ctx tctx =
-	let t = Timer.timer ["finalize"] in
 	let com = ctx.com in
 	let main_module = Finalization.maybe_load_main tctx in
 	enter_stage com CFilteringStart;
@@ -339,14 +337,16 @@ let finalize_typing ctx tctx =
 	let main, types, modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx main_module) in
 	com.main.main_expr <- main;
 	com.types <- types;
-	com.modules <- modules;
-	t()
+	com.modules <- modules
+
+let finalize_typing ctx tctx =
+	Timer.time ctx.timer_ctx ["finalize"] (finalize_typing ctx) tctx
 
 let filter ctx tctx ectx before_destruction =
-	let t = Timer.timer ["filters"] in
-	DeprecationCheck.run ctx.com;
-	run_or_diagnose ctx (fun () -> Filters.run tctx ectx ctx.com.main.main_expr before_destruction);
-	t()
+	Timer.time ctx.timer_ctx ["filters"] (fun () ->
+		DeprecationCheck.run ctx.com;
+		run_or_diagnose ctx (fun () -> Filters.run tctx ectx ctx.com.main.main_expr before_destruction)
+	) ()
 
 let compile ctx actx callbacks =
 	let com = ctx.com in
@@ -370,22 +370,22 @@ let compile ctx actx callbacks =
 	let ext = Setup.initialize_target ctx com actx in
 	update_platform_config com; (* make sure to adapt all flags changes defined after platform *)
 	callbacks.after_target_init ctx;
-	let t = Timer.timer ["init"] in
-	List.iter (fun f -> f()) (List.rev (actx.pre_compilation));
-	begin match actx.hxb_out with
-		| None ->
-			()
-		| Some file ->
-			com.hxb_writer_config <- HxbWriterConfig.process_argument file
-	end;
-	t();
+	Timer.time ctx.timer_ctx ["init"] (fun () ->
+		List.iter (fun f -> f()) (List.rev (actx.pre_compilation));
+		begin match actx.hxb_out with
+			| None ->
+				()
+			| Some file ->
+				com.hxb_writer_config <- HxbWriterConfig.process_argument file
+		end;
+	) ();
 	enter_stage com CInitialized;
 	ServerMessage.compiler_stage com;
 	if actx.classes = [([],"Std")] && not actx.force_typing then begin
 		if actx.cmds = [] && not actx.did_something then actx.raise_usage();
 	end else begin
 		(* Actual compilation starts here *)
-		let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path in
+		let (tctx,display_file_dot_path) = Timer.time ctx.timer_ctx ["typing"] (do_type ctx mctx actx) display_file_dot_path in
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
 		let ectx = Exceptions.create_exception_context tctx in
 		finalize_typing ctx tctx;
@@ -422,7 +422,7 @@ let compile ctx actx callbacks =
 		) (List.rev actx.cmds)
 	end
 
-let make_ice_message com msg backtrace = 
+let make_ice_message com msg backtrace =
 		let ver = (s_version_full com.version) in
 		let os_type = if Sys.unix then "unix" else "windows" in
 		Printf.sprintf "%s\nHaxe: %s; OS type: %s;\n%s" msg ver os_type backtrace
@@ -455,7 +455,7 @@ with
 		error ctx ("Error: " ^ msg) null_pos
 	| Globals.Ice (msg,backtrace) when is_diagnostics com ->
 		let s = make_ice_message com msg backtrace in
-		handle_diagnostics ctx s null_pos DKCompilerMessage 
+		handle_diagnostics ctx s null_pos DKCompilerMessage
 	| Globals.Ice (msg,backtrace) when not Helper.is_debug_run ->
 		let s = make_ice_message com msg backtrace in
 		error ctx ("Error: " ^ s) null_pos
@@ -529,8 +529,8 @@ let compile_ctx callbacks ctx =
 	end else
 		catch_completion_and_exit ctx callbacks run
 
-let create_context comm cs compilation_step params = {
-	com = Common.create compilation_step cs {
+let create_context comm cs timer_ctx compilation_step params = {
+	com = Common.create timer_ctx compilation_step cs {
 		version = version;
 		major = version_major;
 		minor = version_minor;
@@ -543,16 +543,16 @@ let create_context comm cs compilation_step params = {
 	has_error = false;
 	comm = comm;
 	runtime_args = [];
+	timer_ctx = timer_ctx;
 }
 
 module HighLevel = struct
-	let add_libs libs args cs has_display =
+	let add_libs timer_ctx libs args cs has_display =
 		let global_repo = List.exists (fun a -> a = "--haxelib-global") args in
 		let fail msg =
 			raise (Arg.Bad msg)
 		in
 		let call_haxelib() =
-			let t = Timer.timer ["haxelib"] in
 			let cmd = "haxelib" ^ (if global_repo then " --global" else "") ^ " path " ^ String.concat " " libs in
 			let pin, pout, perr = Unix.open_process_full cmd (Unix.environment()) in
 			let lines = Std.input_list pin in
@@ -562,9 +562,11 @@ module HighLevel = struct
 				| [], [] -> "Failed to call haxelib (command not found ?)"
 				| [], [s] when ExtString.String.ends_with (ExtString.String.strip s) "Module not found: path" -> "The haxelib command has been strip'ed, please install it again"
 				| _ -> String.concat "\n" (lines@err));
-			t();
 			lines
 		in
+		let call_haxelib () =
+			Timer.time timer_ctx ["haxelib"] call_haxelib ()
+		in
 		match libs with
 		| [] ->
 			[]
@@ -598,7 +600,7 @@ module HighLevel = struct
 			lines
 
 	(* Returns a list of contexts, but doesn't do anything yet *)
-	let process_params server_api create each_args has_display is_server args =
+	let process_params server_api timer_ctx create each_args has_display is_server args =
 		(* We want the loop below to actually see all the --each params, so let's prepend them *)
 		let args = !each_args @ args in
 		let added_libs = Hashtbl.create 0 in
@@ -656,7 +658,7 @@ module HighLevel = struct
 				let libs,args = find_subsequent_libs [name] args in
 				let libs = List.filter (fun l -> not (Hashtbl.mem added_libs l)) libs in
 				List.iter (fun l -> Hashtbl.add added_libs l ()) libs;
-				let lines = add_libs libs args server_api.cache has_display in
+				let lines = add_libs timer_ctx libs args server_api.cache has_display in
 				loop acc (lines @ args)
 			| ("--jvm" | "-jvm" as arg) :: dir :: args ->
 				loop_lib arg dir "hxjava" acc args
@@ -701,7 +703,8 @@ module HighLevel = struct
 		end
 
 	let entry server_api comm args =
-		let create = create_context comm server_api.cache in
+		let timer_ctx = Timer.make_context (Timer.make ["root"]) in
+		let create = create_context comm server_api.cache timer_ctx in
 		let each_args = ref [] in
 		let curdir = Unix.getcwd () in
 		let has_display = ref false in
@@ -715,7 +718,7 @@ module HighLevel = struct
 		in
 		let rec loop args =
 			let args,server_mode,ctx = try
-				process_params server_api create each_args !has_display comm.is_server args
+				process_params server_api timer_ctx create each_args !has_display comm.is_server args
 			with Arg.Bad msg ->
 				let ctx = create 0 args in
 				error ctx ("Error: " ^ msg) null_pos;
@@ -738,5 +741,5 @@ module HighLevel = struct
 				code
 		in
 		let code = loop args in
-		comm.exit code
+		comm.exit timer_ctx code
 end

src/compiler/displayOutput.ml

@@ -1,7 +1,6 @@
 open Globals
 open Ast
 open Common
-open Timer
 open DisplayTypes.DisplayMode
 open DisplayTypes.CompletionResultKind
 open CompletionItem
@@ -24,14 +23,15 @@ let htmlescape s =
 	let s = String.concat """ (ExtString.String.nsplit s "\"") in
 	s
 
-let get_timer_fields start_time =
+let get_timer_fields timer_ctx =
+	let open Timer in
 	let tot = ref 0. in
-	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Timer.htimers;
-	let fields = [("@TOTAL", Printf.sprintf "%.3fs" (get_time() -. start_time))] in
+	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) timer_ctx.timer_lut;
+	let fields = [("@TOTAL", Printf.sprintf "%.3fs" (Extc.time() -. timer_ctx.start_time))] in
 	if !tot > 0. then
 		Hashtbl.fold (fun _ t acc ->
 			((String.concat "." t.id),(Printf.sprintf "%.3fs (%.0f%%)" t.total (t.total *. 100. /. !tot))) :: acc
-		) Timer.htimers fields
+		) timer_ctx.timer_lut fields
 	else
 		fields
 
@@ -272,11 +272,10 @@ let handle_display_exception_old ctx dex = match dex with
 		raise (Completion (String.concat "." pack))
 	| DisplayFields r ->
 		DisplayPosition.display_position#reset;
-		let fields = if !Timer.measure_times then begin
-			Timer.close_times();
+		let fields = if ctx.com.timer_ctx.measure_times then begin
 			(List.map (fun (name,value) ->
 				CompletionItem.make_ci_timer ("@TIME " ^ name) value
-			) (get_timer_fields !Helper.start_time)) @ r.fitems
+			) (get_timer_fields ctx.com.timer_ctx)) @ r.fitems
 		end else
 			r.fitems
 		in

src/compiler/displayProcessing.ml

@@ -81,7 +81,7 @@ let process_display_arg ctx actx =
 		if String.length input > 0 && (input.[0] = '[' || input.[0] = '{') then begin
 			actx.did_something <- true;
 			actx.force_typing <- true;
-			DisplayJson.parse_input ctx.com input Timer.measure_times
+			DisplayJson.parse_input ctx.com input
 		end else
 			handle_display_argument_old ctx.com input actx;
 	| None ->

src/compiler/generate.ml

@@ -18,7 +18,7 @@ let check_auxiliary_output com actx =
 		| Some file ->
 			Common.log com ("Generating json : " ^ file);
 			Path.mkdir_from_path file;
-			Genjson.generate com.types file
+			Genjson.generate com.timer_ctx com.types file
 	end
 
 let create_writer com config string_pool =
@@ -75,7 +75,7 @@ let check_hxb_output ctx config =
 	let try_write from_cache =
 		let path = config.HxbWriterConfig.archive_path in
 		let path = Str.global_replace (Str.regexp "\\$target") (platform_name ctx.com.platform) path in
-		let t = Timer.timer ["generate";"hxb"] in
+		let t = Timer.start_timer ctx.timer_ctx ["generate";"hxb"] in
 		Path.mkdir_from_path path;
 		let zip = new Zip_output.zip_output path 6 in
 		let export com config string_pool =
@@ -83,10 +83,9 @@ let check_hxb_output ctx config =
 			let target = Common.platform_name_macro com in
 
 			List.iter (fun m ->
-				let t = Timer.timer ["generate";"hxb";s_type_path m.m_path] in
 				let sl_path = fst m.m_path @ [snd m.m_path] in
 				if not (match_path_list config.exclude sl_path) || match_path_list config.include' sl_path then
-					Std.finally t (export_hxb from_cache com config string_pool cc target zip) m
+					Timer.time ctx.timer_ctx ["generate";"hxb";s_type_path m.m_path] (export_hxb from_cache com config string_pool cc target zip) m
 			) com.modules;
 		in
 		Std.finally (fun () ->
@@ -135,10 +134,10 @@ let delete_file f = try Sys.remove f with _ -> ()
 let maybe_generate_dump ctx tctx =
 	let com = tctx.Typecore.com in
 	if Common.defined com Define.Dump then begin
-		let t = Timer.timer ["generate";"dump"] in
-		Dump.dump_types com;
-		Option.may Dump.dump_types (com.get_macros());
-		t()
+		Timer.time ctx.timer_ctx ["generate";"dump"] (fun () ->
+			Dump.dump_types com;
+			Option.may Dump.dump_types (com.get_macros());
+		) ();
 	end;
 	if Common.defined com Define.DumpDependencies then begin
 		Dump.dump_dependencies com;
@@ -160,7 +159,7 @@ let generate ctx tctx ext actx =
 		| _ -> Path.mkdir_from_path com.file
 	end;
 	if actx.interp then begin
-		let timer = Timer.timer ["interp"] in
+		let timer = Timer.start_timer ctx.timer_ctx ["interp"] in
 		let old = tctx.com.args in
 		tctx.com.args <- ctx.runtime_args;
 		let restore () =
@@ -202,8 +201,6 @@ let generate ctx tctx ext actx =
 		if name = "" then ()
 		else begin
 			Common.log com ("Generating " ^ name ^ ": " ^ com.file);
-			let t = Timer.timer ["generate";name] in
-			generate (Common.to_gctx com);
-			t()
+			Timer.time com.timer_ctx ["generate";name] generate (Common.to_gctx com);
 		end
 	end

src/compiler/haxe.ml

@@ -43,12 +43,11 @@
 *)
 open Server
 
-let other = Timer.timer ["other"];;
+;;
 Sys.catch_break true;
 
 let args = List.tl (Array.to_list Sys.argv) in
 set_binary_mode_out stdout true;
 set_binary_mode_out stderr true;
 let sctx = ServerCompilationContext.create false in
-Server.process sctx (Communication.create_stdio ()) args;
-other()
+Server.process sctx (Communication.create_stdio ()) args;

src/compiler/helper.ml

@@ -3,8 +3,6 @@ exception HelpMessage of string
 
 let is_debug_run = try Sys.getenv "HAXEDEBUG" = "1" with _ -> false
 
-let start_time = ref (Timer.get_time())
-
 let prompt = ref false
 
 let expand_env ?(h=None) path  =

src/compiler/hxb/hxbLib.ml

@@ -2,7 +2,7 @@ open Globals
 open Common
 open ExtString
 
-class hxb_library file_path hxb_times = object(self)
+class hxb_library timer_ctx file_path hxb_times = object(self)
 	inherit abstract_hxb_lib
 	val zip = lazy (Zip.open_in file_path)
 
@@ -13,42 +13,43 @@ class hxb_library file_path hxb_times = object(self)
 	val mutable string_pool : string array option = None
 	val mutable macro_string_pool : string array option = None
 
+	method private do_load =
+		List.iter (function
+		| ({ Zip.filename = "StringPool.hxb" | "StringPool.macro.hxb" as filename} as entry) ->
+			let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None hxb_times in
+			let zip = Lazy.force zip in
+			let data = Bytes.unsafe_of_string (Zip.read_entry zip entry) in
+			ignore(reader#read (new HxbReaderApi.hxb_reader_api_null) data STR);
+			if filename = "StringPool.hxb" then
+				string_pool <- reader#get_string_pool
+			else
+				macro_string_pool <- reader#get_string_pool
+		| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".hxb" ->
+			let pack = String.nsplit filename "/" in
+			begin match List.rev pack with
+				| [] -> ()
+				| name :: pack ->
+					let name = String.sub name 0 (String.length name - 4) in
+					let pack = List.rev pack in
+					Hashtbl.add modules (pack,name) (filename,entry);
+				end
+		| _ -> ()
+	) (Zip.entries (Lazy.force zip));
+
 	method load =
 		if not loaded then begin
 			loaded <- true;
-			let close = Timer.timer ["hxblib";"read"] in
-			List.iter (function
-				| ({ Zip.filename = "StringPool.hxb" | "StringPool.macro.hxb" as filename} as entry) ->
-					let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None hxb_times in
-					let zip = Lazy.force zip in
-					let data = Bytes.unsafe_of_string (Zip.read_entry zip entry) in
-					ignore(reader#read (new HxbReaderApi.hxb_reader_api_null) data STR);
-					if filename = "StringPool.hxb" then
-						string_pool <- reader#get_string_pool
-					else
-						macro_string_pool <- reader#get_string_pool
-				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".hxb" ->
-					let pack = String.nsplit filename "/" in
-					begin match List.rev pack with
-						| [] -> ()
-						| name :: pack ->
-							let name = String.sub name 0 (String.length name - 4) in
-							let pack = List.rev pack in
-							Hashtbl.add modules (pack,name) (filename,entry);
-						end
-				| _ -> ()
-			) (Zip.entries (Lazy.force zip));
-			close();
+			Timer.time timer_ctx ["hxblib";"read"] (fun () -> self#do_load) ()
 		end
 
 	method get_bytes (target : string) (path : path) =
 		try
 			let path = (target :: fst path,snd path) in
 			let (filename,entry) = Hashtbl.find modules path in
-			let close = Timer.timer ["hxblib";"get bytes"] in
-			let zip = Lazy.force zip in
-			let data = Zip.read_entry zip entry in
-			close();
+			let data = Timer.time timer_ctx ["hxblib";"get bytes"] (fun () ->
+				let zip = Lazy.force zip in
+				Zip.read_entry zip entry
+			) () in
 			Some (Bytes.unsafe_of_string data)
 		with Not_found ->
 			None
@@ -74,4 +75,4 @@ let create_hxb_lib com file_path =
 	with Not_found ->
 		failwith ("hxb lib " ^ file_path ^ " not found")
 	in
-	new hxb_library file (Common.defined com Define.HxbTimes)
+	new hxb_library com.timer_ctx file (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None)

src/compiler/hxb/hxbReader.ml

@@ -149,7 +149,7 @@ class hxb_reader
 	(mpath : path)
 	(stats : hxb_reader_stats)
 	(string_pool : string array option)
-	(timers_enabled : bool)
+	(timer_ctx : Timer.timer_context option)
 = object(self)
 	val mutable api = Obj.magic ""
 	val mutable full_restore = true
@@ -2084,7 +2084,10 @@ class hxb_reader
 	method private read_chunk_data kind =
 		let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
 		let id = ["hxb";"read";string_of_chunk_kind kind;path] in
-		let close = if timers_enabled then Timer.timer id else fun() -> () in
+		let close = match timer_ctx with
+			| Some timer_ctx -> Timer.start_timer timer_ctx id
+			| None -> (fun () -> ())
+		in
 		try
 			self#read_chunk_data' kind
 		with Invalid_argument msg -> begin

src/compiler/server.ml

@@ -1,7 +1,6 @@
 open Globals
 open Common
 open CompilationCache
-open Timer
 open Type
 open DisplayProcessingGlobals
 open Ipaddr
@@ -54,7 +53,7 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 		TypeloadParse.parse_file_from_string com file p stdin
 	| _ ->
 		let ftime = file_time ffile in
-		let data = Std.finally (Timer.timer ["server";"parser cache"]) (fun () ->
+		let data = Std.finally (Timer.start_timer com.timer_ctx ["server";"parser cache"]) (fun () ->
 			try
 				let cfile = cc#find_file fkey in
 				if cfile.c_time <> ftime then raise Not_found;
@@ -113,10 +112,9 @@ module Communication = struct
 				end;
 				flush stdout;
 			);
-			exit = (fun code ->
+			exit = (fun timer_ctx code ->
 				if code = 0 then begin
-					Timer.close_times();
-					if !Timer.measure_times then Timer.report_times (fun s -> self.write_err (s ^ "\n"));
+					if timer_ctx.measure_times then Timer.report_times timer_ctx (fun s -> self.write_err (s ^ "\n"));
 				end;
 				exit code;
 			);
@@ -141,15 +139,14 @@ module Communication = struct
 
 					sctx.was_compilation <- ctx.com.display.dms_full_typing;
 					if has_error ctx then begin
-						measure_times := false;
+						ctx.timer_ctx.measure_times <- false;
 						write "\x02\n"
 					end else begin
-						Timer.close_times();
-						if !Timer.measure_times then Timer.report_times (fun s -> self.write_err (s ^ "\n"));
+						if ctx.timer_ctx.measure_times then Timer.report_times ctx.timer_ctx (fun s -> self.write_err (s ^ "\n"));
 					end
 				)
 			);
-			exit = (fun i ->
+			exit = (fun timer_ctx i ->
 				()
 			);
 			is_server = true;
@@ -163,7 +160,6 @@ let stat dir =
 
 (* Gets a list of changed directories for the current compilation. *)
 let get_changed_directories sctx com =
-	let t = Timer.timer ["server";"module cache";"changed dirs"] in
 	let cs = sctx.cs in
 	let sign = Define.get_signature com.defines in
 	let dirs = try
@@ -223,9 +219,11 @@ let get_changed_directories sctx com =
 		Hashtbl.add sctx.changed_directories sign dirs;
 		dirs
 	in
-	t();
 	dirs
 
+let get_changed_directories sctx com =
+	Timer.time com.Common.timer_ctx ["server";"module cache";"changed dirs"] (get_changed_directories sctx) com
+
 let full_typing com m_extra =
 	com.is_macro_context
 	|| com.display.dms_full_typing
@@ -438,14 +436,12 @@ class hxb_reader_api_server
 		| GoodModule m ->
 			m
 		| BinaryModule mc ->
-			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 			let full_restore = full_typing com mc.mc_extra in
 			let f_next chunks until =
 				let macro = if com.is_macro_context then " (macro)" else "" in
-				let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in
-				let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until full_restore in
-				t_hxb();
-				r
+				let f  = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in
+				Timer.time com.timer_ctx ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] f full_restore
 			in
 
 			let m,chunks = f_next mc.mc_chunks EOT in
@@ -539,23 +535,18 @@ let rec add_modules sctx com delay (m : module_def) (from_binary : bool) (p : po
 (* Looks up the module referred to by [mpath] in the cache. If it exists, a check is made to
    determine if it's still valid. If this function returns None, the module is re-typed. *)
 and type_module sctx com delay mpath p =
-	let t = Timer.timer ["server";"module cache"] in
+	let t = Timer.start_timer com.timer_ctx ["server";"module cache"] in
 	let cc = CommonCache.get_cache com in
 	let skip m_path reason =
 		ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason));
 		BadModule reason
 	in
 	let add_modules from_binary m =
-		let tadd = Timer.timer ["server";"module cache";"add modules"] in
-		add_modules sctx com delay m from_binary p;
-		tadd();
+		Timer.time com.timer_ctx ["server";"module cache";"add modules"] (add_modules sctx com delay m from_binary) p;
 		GoodModule m
 	in
 	let check_module sctx m_path m_extra p =
-		let tcheck = Timer.timer ["server";"module cache";"check"] in
-		let r = check_module sctx com mpath m_extra p in
-		tcheck();
-		r
+		Timer.time com.timer_ctx ["server";"module cache";"check"] (check_module sctx com mpath m_extra) p
 	in
 	let find_module_in_cache cc m_path p =
 		try
@@ -582,7 +573,7 @@ and type_module sctx com delay mpath p =
 			   checking dependencies. This means that the actual decoding never has any reason to fail. *)
 			begin match check_module sctx mpath mc.mc_extra p with
 				| None ->
-					let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+					let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 					let full_restore = full_typing com mc.mc_extra in
 					let api = match com.hxb_reader_api with
 						| Some api ->
@@ -594,10 +585,7 @@ and type_module sctx com delay mpath p =
 					in
 					let f_next chunks until =
 						let macro = if com.is_macro_context then " (macro)" else "" in
-						let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in
-						let r = reader#read_chunks_until api chunks until full_restore in
-						t_hxb();
-						r
+						Timer.time com.timer_ctx ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] (reader#read_chunks_until api chunks until) full_restore
 					in
 
 					let m,chunks = f_next mc.mc_chunks EOT in
@@ -785,7 +773,7 @@ let enable_cache_mode sctx =
 	TypeloadParse.parse_hook := parse_file sctx.cs
 
 let rec process sctx comm args =
-	let t0 = get_time() in
+	let t0 = Extc.time() in
 	ServerMessage.arguments args;
 	reset sctx;
 	let api = {
@@ -808,7 +796,7 @@ let rec process sctx comm args =
 	} in
 	Compiler.HighLevel.entry api comm args;
 	run_delays sctx;
-	ServerMessage.stats stats (get_time() -. t0)
+	ServerMessage.stats stats (Extc.time() -. t0)
 
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
    parameters through [process_params]. *)

src/compiler/serverCompilationContext.ml

@@ -1,5 +1,4 @@
 open Common
-open Timer
 open CompilationCache
 
 type t = {
@@ -46,21 +45,15 @@ let reset sctx =
 	sctx.was_compilation <- false;
 	Parser.reset_state();
 	Lexer.cur := Lexer.make_file "";
-	measure_times := false;
 	Hashtbl.clear DeprecationCheck.warned_positions;
-	close_times();
 	stats.s_files_parsed := 0;
 	stats.s_classes_built := 0;
 	stats.s_methods_typed := 0;
-	stats.s_macros_called := 0;
-	Hashtbl.clear Timer.htimers;
-	Helper.start_time := get_time()
+	stats.s_macros_called := 0
 
 let maybe_cache_context sctx com =
 	if com.display.dms_full_typing && com.display.dms_populate_cache then begin
-		let t = Timer.timer ["server";"cache context"] in
-		CommonCache.cache_context sctx.cs com;
-		t();
+		Timer.time com.timer_ctx ["server";"cache context"] (CommonCache.cache_context sctx.cs) com;
 		ServerMessage.cached_modules com "" (List.length com.modules);
 	end
 

src/compiler/tasks.ml

@@ -6,7 +6,7 @@ class gc_task (max_working_memory : float) (heap_size : float) = object(self)
 	inherit server_task ["gc"] 100
 
 	method private execute =
-		let t0 = Timer.get_time() in
+		let t0 = Extc.time() in
 		let stats = Gc.stat() in
 		let live_words = float_of_int stats.live_words in
 		(* Maximum heap size needed for the last X compilations = sum of what's live + max working memory. *)
@@ -27,7 +27,7 @@ class gc_task (max_working_memory : float) (heap_size : float) = object(self)
 			Gc.full_major();
 		end;
 		Gc.set old_gc;
-		ServerMessage.gc_stats (Timer.get_time() -. t0) stats do_compact new_space_overhead
+		ServerMessage.gc_stats (Extc.time() -. t0) stats do_compact new_space_overhead
 end
 
 class class_maintenance_task (cs : CompilationCache.t) (c : tclass) = object(self)

src/context/common.ml

@@ -234,6 +234,7 @@ type context = {
 	mutable cache : CompilationCache.context_cache option;
 	is_macro_context : bool;
 	mutable json_out : json_api option;
+	timer_ctx : Timer.timer_context;
 	(* config *)
 	version : compiler_version;
 	mutable args : string list;
@@ -331,6 +332,7 @@ let to_gctx com = {
 		| _ -> []);
 	include_files = com.include_files;
 	std = com.std;
+	timer_ctx = com.timer_ctx;
 }
 
 let to_safe_com com = {
@@ -344,6 +346,7 @@ let to_safe_com com = {
 	exceptions_mutex = Mutex.create ();
 	warnings = ref [];
 	warnings_mutex = Mutex.create ();
+	timer_ctx = com.timer_ctx;
 	curclass = null_class;
 	curfield = null_field;
 }
@@ -688,11 +691,12 @@ let get_config com =
 
 let memory_marker = [|Unix.time()|]
 
-let create compilation_step cs version args display_mode =
+let create timer_ctx compilation_step cs version args display_mode =
 	let rec com = {
 		compilation_step = compilation_step;
 		cs = cs;
 		cache = None;
+		timer_ctx = timer_ctx;
 		stage = CCreated;
 		version = version;
 		args = args;
@@ -983,10 +987,6 @@ let platform_name_macro com =
 let find_file ctx f =
 	(ctx.class_paths#find_file f).file
 
-(* let find_file ctx f =
-	let timer = Timer.timer ["find_file"] in
-	Std.finally timer (find_file ctx) f *)
-
 let mem_size v =
 	Objsize.size_with_headers (Objsize.objsize v [] [])
 

src/context/display/displayJson.ml

@@ -139,7 +139,7 @@ class hxb_reader_api_com
 			cc#find_module m_path
 		with Not_found ->
 			let mc = cc#get_hxb_module m_path in
-			let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+			let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 			fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if full_restore then EOM else MTF) full_restore)
 
 	method basic_types =
@@ -493,7 +493,7 @@ let handler =
 	List.iter (fun (s,f) -> Hashtbl.add h s f) l;
 	h
 
-let parse_input com input report_times =
+let parse_input com input =
 	let input =
 		JsonRpc.handle_jsonrpc_error (fun () -> JsonRpc.parse_request input) send_json
 	in
@@ -506,9 +506,8 @@ let parse_input com input report_times =
 			"result",json;
 			"timestamp",jfloat (Unix.gettimeofday ());
 		] in
-		let fl = if !report_times then begin
-			close_times();
-			let _,_,root = Timer.build_times_tree () in
+		let fl = if com.timer_ctx.measure_times then begin
+			let _,_,root = Timer.build_times_tree com.timer_ctx in
 			begin match json_of_times root with
 			| None -> fl
 			| Some jo -> ("timers",jo) :: fl

src/context/display/displayTexpr.ml

@@ -178,7 +178,7 @@ let check_display_file ctx cs =
 				| NoModule | BadModule _ -> raise Not_found
 				| BinaryModule mc ->
 					let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in
-					let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined ctx.com Define.HxbTimes) in
+					let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (Some cc#get_string_pool_arr) (if Common.defined ctx.com Define.HxbTimes then Some ctx.com.timer_ctx else None) in
 					let m = reader#read_chunks api mc.mc_chunks in
 					m
 				| GoodModule m ->

src/context/display/displayToplevel.ml

@@ -109,20 +109,20 @@ end
 
 let explore_class_paths com timer class_paths recursive f_pack f_module =
 	let cs = com.cs in
-	let t = Timer.timer (timer @ ["class path exploration"]) in
-	let checked = Hashtbl.create 0 in
-	let tasks = ExtList.List.filter_map (fun path ->
-		match path#get_directory_path with
-			| Some path ->
-				Some (new explore_class_path_task com checked recursive f_pack f_module path [])
-			| None ->
-				None
-	) class_paths in
-	let task = new arbitrary_task ["explore"] 50 (fun () ->
-		List.iter (fun task -> task#run) tasks
-	) in
-	cs#add_task task;
-	t()
+	Timer.time com.timer_ctx (timer @ ["class path exploration"]) (fun () ->
+		let checked = Hashtbl.create 0 in
+		let tasks = ExtList.List.filter_map (fun path ->
+			match path#get_directory_path with
+				| Some path ->
+					Some (new explore_class_path_task com checked recursive f_pack f_module path [])
+				| None ->
+					None
+		) class_paths in
+		let task = new arbitrary_task ["explore"] 50 (fun () ->
+			List.iter (fun task -> task#run) tasks
+		) in
+		cs#add_task task;
+	) ()
 
 let read_class_paths com timer =
 	explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
@@ -225,7 +225,6 @@ let is_pack_visible pack =
 	not (List.exists (fun s -> String.length s > 0 && s.[0] = '_') pack)
 
 let collect ctx tk with_type sort =
-	let t = Timer.timer ["display";"toplevel collect"] in
 	let cctx = CollectionContext.create ctx in
 	let curpack = fst ctx.c.curclass.cl_path in
 	(* Note: This checks for the explicit `ServerConfig.legacy_completion` setting instead of using
@@ -298,12 +297,12 @@ let collect ctx tk with_type sort =
 	| TKType | TKOverride -> ()
 	| TKExpr p | TKPattern p | TKField p ->
 		(* locals *)
-		let t = Timer.timer ["display";"toplevel collect";"locals"] in
-		PMap.iter (fun _ v ->
-			if not (is_gen_local v) then
-				add (make_ci_local v (tpair ~values:(get_value_meta v.v_meta) v.v_type)) (Some v.v_name)
-		) ctx.f.locals;
-		t();
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"locals"] (fun () ->
+			PMap.iter (fun _ v ->
+				if not (is_gen_local v) then
+					add (make_ci_local v (tpair ~values:(get_value_meta v.v_meta) v.v_type)) (Some v.v_name)
+			) ctx.f.locals;
+		) ();
 
 		let add_field scope origin cf =
 			let origin,cf = match origin with
@@ -329,137 +328,137 @@ let collect ctx tk with_type sort =
 			if not (Meta.has Meta.NoCompletion cf.cf_meta) then add_field scope origin cf
 		in
 
-		let t = Timer.timer ["display";"toplevel collect";"fields"] in
-		(* member fields *)
-		if ctx.e.curfun <> FunStatic then begin
-			let all_fields = Type.TClass.get_all_fields ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) in
-			PMap.iter (fun _ (c,cf) ->
-				let origin = if c == ctx.c.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
-				maybe_add_field CFSMember origin cf
-			) all_fields;
-			(* TODO: local using? *)
-		end;
-
-		(* statics *)
-		begin match ctx.c.curclass.cl_kind with
-		| KAbstractImpl ({a_impl = Some c} as a) ->
-			let origin = Self (TAbstractDecl a) in
-			List.iter (fun cf ->
-				if has_class_field_flag cf CfImpl then begin
-					if ctx.e.curfun = FunStatic then ()
-					else begin
-						let cf = prepare_using_field cf in
-						maybe_add_field CFSMember origin cf
-					end
-				end else
-					maybe_add_field CFSStatic origin cf
-			) c.cl_ordered_statics
-		| _ ->
-			List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.c.curclass))) ctx.c.curclass.cl_ordered_statics
-		end;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"enum ctors"] in
-		(* enum constructors *)
-		let rec enum_ctors t =
-			match t with
-			| TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.c.curclass != c ->
-				add_path cctx a.a_path;
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"fields"] (fun () ->
+			(* member fields *)
+			if ctx.e.curfun <> FunStatic then begin
+				let all_fields = Type.TClass.get_all_fields ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) in
+				PMap.iter (fun _ (c,cf) ->
+					let origin = if c == ctx.c.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
+					maybe_add_field CFSMember origin cf
+				) all_fields;
+				(* TODO: local using? *)
+			end;
+
+			(* statics *)
+			begin match ctx.c.curclass.cl_kind with
+			| KAbstractImpl ({a_impl = Some c} as a) ->
+				let origin = Self (TAbstractDecl a) in
 				List.iter (fun cf ->
-					let ccf = CompletionClassField.make cf CFSMember (Self (decl_of_class c)) true in
-					if (has_class_field_flag cf CfEnum) && not (Meta.has Meta.NoCompletion cf.cf_meta) then
-						add (make_ci_enum_abstract_field a ccf (tpair cf.cf_type)) (Some cf.cf_name);
+					if has_class_field_flag cf CfImpl then begin
+						if ctx.e.curfun = FunStatic then ()
+						else begin
+							let cf = prepare_using_field cf in
+							maybe_add_field CFSMember origin cf
+						end
+					end else
+						maybe_add_field CFSStatic origin cf
 				) c.cl_ordered_statics
-			| TTypeDecl t ->
-				begin match follow t.t_type with
-					| TEnum (e,_) -> enum_ctors (TEnumDecl e)
-					| _ -> ()
-				end
-			| TEnumDecl e when not (path_exists cctx e.e_path) ->
-				add_path cctx e.e_path;
-				let origin = Self (TEnumDecl e) in
-				PMap.iter (fun _ ef ->
-					let is_qualified = is_qualified cctx ef.ef_name in
-					add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some ef.ef_name)
-				) e.e_constrs;
 			| _ ->
-				()
-		in
-		List.iter enum_ctors ctx.m.curmod.m_types;
-		List.iter enum_ctors (List.map fst ctx.m.import_resolution#extract_type_imports);
-
-		(* enum constructors of expected type *)
-		begin match with_type with
-			| WithType.WithType(t,_) ->
-				(try enum_ctors (module_type_of_type (follow t)) with Exit -> ())
-			| _ -> ()
-		end;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"globals"] in
-		(* imported globals *)
-		PMap.iter (fun name (mt,s,_) ->
-			try
-				let is_qualified = is_qualified cctx name in
-				let class_import c =
-					let cf = PMap.find s c.cl_statics in
-					let cf = if name = cf.cf_name then cf else {cf with cf_name = name} in
-					let decl,make = match c.cl_kind with
-						| KAbstractImpl a -> TAbstractDecl a,
-							if has_class_field_flag cf CfEnum then make_ci_enum_abstract_field a else make_ci_class_field
-						| _ -> TClassDecl c,make_ci_class_field
+				List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.c.curclass))) ctx.c.curclass.cl_ordered_statics
+			end;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"enum ctors"] (fun () ->
+			(* enum constructors *)
+			let rec enum_ctors t =
+				match t with
+				| TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.c.curclass != c ->
+					add_path cctx a.a_path;
+					List.iter (fun cf ->
+						let ccf = CompletionClassField.make cf CFSMember (Self (decl_of_class c)) true in
+						if (has_class_field_flag cf CfEnum) && not (Meta.has Meta.NoCompletion cf.cf_meta) then
+							add (make_ci_enum_abstract_field a ccf (tpair cf.cf_type)) (Some cf.cf_name);
+					) c.cl_ordered_statics
+				| TTypeDecl t ->
+					begin match follow t.t_type with
+						| TEnum (e,_) -> enum_ctors (TEnumDecl e)
+						| _ -> ()
+					end
+				| TEnumDecl e when not (path_exists cctx e.e_path) ->
+					add_path cctx e.e_path;
+					let origin = Self (TEnumDecl e) in
+					PMap.iter (fun _ ef ->
+						let is_qualified = is_qualified cctx ef.ef_name in
+						add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some ef.ef_name)
+					) e.e_constrs;
+				| _ ->
+					()
+			in
+			List.iter enum_ctors ctx.m.curmod.m_types;
+			List.iter enum_ctors (List.map fst ctx.m.import_resolution#extract_type_imports);
+
+			(* enum constructors of expected type *)
+			begin match with_type with
+				| WithType.WithType(t,_) ->
+					(try enum_ctors (module_type_of_type (follow t)) with Exit -> ())
+				| _ -> ()
+			end;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"globals"] (fun () ->
+			(* imported globals *)
+			PMap.iter (fun name (mt,s,_) ->
+				try
+					let is_qualified = is_qualified cctx name in
+					let class_import c =
+						let cf = PMap.find s c.cl_statics in
+						let cf = if name = cf.cf_name then cf else {cf with cf_name = name} in
+						let decl,make = match c.cl_kind with
+							| KAbstractImpl a -> TAbstractDecl a,
+								if has_class_field_flag cf CfEnum then make_ci_enum_abstract_field a else make_ci_class_field
+							| _ -> TClassDecl c,make_ci_class_field
+						in
+						let origin = StaticImport decl in
+						if can_access ctx c cf true && not (Meta.has Meta.NoCompletion cf.cf_meta) then begin
+							add (make (CompletionClassField.make cf CFSStatic origin is_qualified) (tpair ~values:(get_value_meta cf.cf_meta) cf.cf_type)) (Some name)
+						end
 					in
-					let origin = StaticImport decl in
-					if can_access ctx c cf true && not (Meta.has Meta.NoCompletion cf.cf_meta) then begin
-						add (make (CompletionClassField.make cf CFSStatic origin is_qualified) (tpair ~values:(get_value_meta cf.cf_meta) cf.cf_type)) (Some name)
+					match resolve_typedef mt with
+						| TClassDecl c -> class_import c;
+						| TEnumDecl en ->
+							let ef = PMap.find s en.e_constrs in
+							let ef = if name = ef.ef_name then ef else {ef with ef_name = name} in
+							let origin = StaticImport (TEnumDecl en) in
+							add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some s)
+						| TAbstractDecl {a_impl = Some c} -> class_import c;
+						| _ -> raise Not_found
+				with Not_found ->
+					()
+			) ctx.m.import_resolution#extract_field_imports;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"rest"] (fun () ->
+			(* literals *)
+			add (make_ci_literal "null" (tpair t_dynamic)) (Some "null");
+			add (make_ci_literal "true" (tpair ctx.com.basic.tbool)) (Some "true");
+			add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false");
+			begin match ctx.e.curfun with
+				| FunMember | FunConstructor | FunMemberClassLocal ->
+					let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
+					add (make_ci_literal "this" (tpair t)) (Some "this");
+					begin match ctx.c.curclass.cl_super with
+						| Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super")
+						| None -> ()
 					end
-				in
-				match resolve_typedef mt with
-					| TClassDecl c -> class_import c;
-					| TEnumDecl en ->
-						let ef = PMap.find s en.e_constrs in
-						let ef = if name = ef.ef_name then ef else {ef with ef_name = name} in
-						let origin = StaticImport (TEnumDecl en) in
-						add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some s)
-					| TAbstractDecl {a_impl = Some c} -> class_import c;
-					| _ -> raise Not_found
-			with Not_found ->
-				()
-		) ctx.m.import_resolution#extract_field_imports;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"rest"] in
-		(* literals *)
-		add (make_ci_literal "null" (tpair t_dynamic)) (Some "null");
-		add (make_ci_literal "true" (tpair ctx.com.basic.tbool)) (Some "true");
-		add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false");
-		begin match ctx.e.curfun with
-			| FunMember | FunConstructor | FunMemberClassLocal ->
-				let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
-				add (make_ci_literal "this" (tpair t)) (Some "this");
-				begin match ctx.c.curclass.cl_super with
-					| Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super")
-					| None -> ()
-				end
-			| FunMemberAbstract ->
-				let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
-				add (make_ci_literal "abstract" (tpair t)) (Some "abstract");
-			| _ ->
-				()
-		end;
-
-		if not is_legacy_completion then begin
-			(* keywords *)
-			let kwds = [
-				Function; Var; Final; If; Else; While; Do; For; Break; Return; Continue; Switch;
-				Try; New; Throw; Untyped; Cast; Inline;
-			] in
-			List.iter (fun kwd -> add(make_ci_keyword kwd) (Some (s_keyword kwd))) kwds;
-
-			(* builtins *)
-			add (make_ci_literal "trace" (tpair (TFun(["value",false,t_dynamic],ctx.com.basic.tvoid)))) (Some "trace")
-		end;
-		t()
+				| FunMemberAbstract ->
+					let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
+					add (make_ci_literal "abstract" (tpair t)) (Some "abstract");
+				| _ ->
+					()
+			end;
+
+			if not is_legacy_completion then begin
+				(* keywords *)
+				let kwds = [
+					Function; Var; Final; If; Else; While; Do; For; Break; Return; Continue; Switch;
+					Try; New; Throw; Untyped; Cast; Inline;
+				] in
+				List.iter (fun kwd -> add(make_ci_keyword kwd) (Some (s_keyword kwd))) kwds;
+
+				(* builtins *)
+				add (make_ci_literal "trace" (tpair (TFun(["value",false,t_dynamic],ctx.com.basic.tvoid)))) (Some "trace")
+			end;
+		) ();
 	end;
 
 	(* type params *)
@@ -473,75 +472,76 @@ let collect ctx tk with_type sort =
 	(* module imports *)
 	List.iter add_type (List.rev_map fst ctx.m.import_resolution#extract_type_imports); (* reverse! *)
 
-	let t_syntax = Timer.timer ["display";"toplevel collect";"syntax"] in
-	(* types from files *)
 	let cs = ctx.com.cs in
-	(* online: iter context files *)
-	init_or_update_server cs ctx.com ["display";"toplevel"];
-	let cc = CommonCache.get_cache ctx.com in
-	let files = cc#get_files in
-	(* Sort files by reverse distance of their package to our current package. *)
-	let files = Hashtbl.fold (fun file cfile acc ->
-		let i = pack_similarity curpack cfile.c_package in
-		((file,cfile),i) :: acc
-	) files [] in
-	let files = List.sort (fun (_,i1) (_,i2) -> -compare i1 i2) files in
-	let check_package pack = match List.rev pack with
+		let check_package pack = match List.rev pack with
 		| [] -> ()
 		| s :: sl -> add_package (List.rev sl,s)
 	in
-	List.iter (fun ((file_key,cfile),_) ->
-		let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path.file cfile in
-		let dot_path = s_type_path (cfile.c_package,module_name) in
-		(* In legacy mode we only show toplevel types. *)
-		if is_legacy_completion && cfile.c_package <> [] then begin
-			(* And only toplevel packages. *)
-			match cfile.c_package with
-			| [s] -> add_package ([],s)
-			| _ -> ()
-		end else if (List.exists (fun e -> ExtString.String.starts_with dot_path (e ^ ".")) !exclude) then
-			()
-		else begin
-			ctx.com.module_to_file#add (cfile.c_package,module_name) cfile.c_file_path;
-			if process_decls cfile.c_package module_name cfile.c_decls then check_package cfile.c_package;
-		end
-	) files;
-	t_syntax();
-
-	let t_native_lib = Timer.timer ["display";"toplevel collect";"native lib"] in
-	List.iter (fun file ->
-		match cs#get_native_lib file with
-		| Some lib ->
-			Hashtbl.iter (fun path (pack,decls) ->
-				if process_decls pack (snd path) decls then check_package pack;
-			) lib.c_nl_files
-		| None ->
-			()
-	) ctx.com.native_libs.all_libs;
-	t_native_lib();
-
-	let t_packages = Timer.timer ["display";"toplevel collect";"packages"] in
-	(* packages *)
-	Hashtbl.iter (fun path _ ->
-		let full_pack = fst path @ [snd path] in
-		if is_pack_visible full_pack then add (make_ci_package path []) (Some (snd path))
-	) packages;
-	t_packages();
-
-	t();
-
-	let t = Timer.timer ["display";"toplevel sorting"] in
-	(* sorting *)
-	let l = DynArray.to_list cctx.items in
-	let l = if is_legacy_completion then
-		List.sort (fun item1 item2 -> compare (get_name item1) (get_name item2)) l
-	else if sort then
-		Display.sort_fields l with_type tk
-	else
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"syntax"] (fun () ->
+		(* types from files *)
+		(* online: iter context files *)
+		init_or_update_server cs ctx.com ["display";"toplevel"];
+		let cc = CommonCache.get_cache ctx.com in
+		let files = cc#get_files in
+		(* Sort files by reverse distance of their package to our current package. *)
+		let files = Hashtbl.fold (fun file cfile acc ->
+			let i = pack_similarity curpack cfile.c_package in
+			((file,cfile),i) :: acc
+		) files [] in
+		let files = List.sort (fun (_,i1) (_,i2) -> -compare i1 i2) files in
+		List.iter (fun ((file_key,cfile),_) ->
+			let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path.file cfile in
+			let dot_path = s_type_path (cfile.c_package,module_name) in
+			(* In legacy mode we only show toplevel types. *)
+			if is_legacy_completion && cfile.c_package <> [] then begin
+				(* And only toplevel packages. *)
+				match cfile.c_package with
+				| [s] -> add_package ([],s)
+				| _ -> ()
+			end else if (List.exists (fun e -> ExtString.String.starts_with dot_path (e ^ ".")) !exclude) then
+				()
+			else begin
+				ctx.com.module_to_file#add (cfile.c_package,module_name) cfile.c_file_path;
+				if process_decls cfile.c_package module_name cfile.c_decls then check_package cfile.c_package;
+			end
+		) files;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"native lib"] (fun () ->
+		List.iter (fun file ->
+			match cs#get_native_lib file with
+			| Some lib ->
+				Hashtbl.iter (fun path (pack,decls) ->
+					if process_decls pack (snd path) decls then check_package pack;
+				) lib.c_nl_files
+			| None ->
+				()
+		) ctx.com.native_libs.all_libs;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"packages"] (fun () ->
+		(* packages *)
+		Hashtbl.iter (fun path _ ->
+			let full_pack = fst path @ [snd path] in
+			if is_pack_visible full_pack then add (make_ci_package path []) (Some (snd path))
+		) packages;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel sorting"] (fun () ->
+		(* sorting *)
+		let l = DynArray.to_list cctx.items in
+		let l = if is_legacy_completion then
+			List.sort (fun item1 item2 -> compare (get_name item1) (get_name item2)) l
+		else if sort then
+			Display.sort_fields l with_type tk
+		else
+			l
+		in
 		l
-	in
-	t();
-	l
+	) ()
+
+let collect ctx tk with_type sort =
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect"] (collect ctx tk with_type) sort
 
 let collect_and_raise ctx tk with_type cr (name,pname) pinsert =
 	let fields = match !DisplayException.last_completion_pos with

src/context/display/findReferences.ml

@@ -9,21 +9,19 @@ let find_possible_references tctx cs =
 	ignore(SyntaxExplorer.explore_uncached_modules tctx cs [name,kind])
 
 let find_references tctx com with_definition pos_filters =
-	let t = Timer.timer ["display";"references";"collect"] in
-	let symbols,relations = Statistics.collect_statistics tctx pos_filters true in
-	t();
+	let symbols,relations = Timer.time com.timer_ctx ["display";"references";"collect"] (Statistics.collect_statistics tctx pos_filters) true in
 	let rec loop acc (relations:(Statistics.relation * pos) list) = match relations with
 		| (Statistics.Referenced,p) :: relations when not (List.mem p acc) -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 	in
-	let t = Timer.timer ["display";"references";"filter"] in
-	let usages = Hashtbl.fold (fun p sym acc ->
-		let acc = if with_definition then p :: acc else acc in
-		(try loop acc (Hashtbl.find relations p)
-		with Not_found -> acc)
-	) symbols [] in
-	t();
+	let usages = Timer.time com.timer_ctx ["display";"references";"filter"] (fun () ->
+		Hashtbl.fold (fun p sym acc ->
+			let acc = if with_definition then p :: acc else acc in
+			(try loop acc (Hashtbl.find relations p)
+			with Not_found -> acc)
+		) symbols []
+	) () in
 	Display.ReferencePosition.reset();
 	usages
 
@@ -138,24 +136,22 @@ let find_references tctx com with_definition =
 	DisplayException.raise_positions usages
 
 let find_implementations tctx com name pos kind =
-	let t = Timer.timer ["display";"implementations";"collect"] in
-	let symbols,relations = Statistics.collect_statistics tctx [SFPos pos] false in
-	t();
+	let symbols,relations = Timer.time com.timer_ctx ["display";"implementations";"collect"] (Statistics.collect_statistics tctx [SFPos pos]) false in
 	let rec loop acc relations = match relations with
 		| ((Statistics.Implemented | Statistics.Overridden | Statistics.Extended),p) :: relations -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 	in
-	let t = Timer.timer ["display";"implementations";"filter"] in
-	let usages = Hashtbl.fold (fun p sym acc ->
-		(try loop acc (Hashtbl.find relations p)
-		with Not_found -> acc)
-	) symbols [] in
-	let usages = List.sort (fun p1 p2 ->
-		let c = compare p1.pfile p2.pfile in
-		if c <> 0 then c else compare p1.pmin p2.pmin
-	) usages in
-	t();
+	let usages = Timer.time com.timer_ctx ["display";"implementations";"filter"] (fun () ->
+		let usages = Hashtbl.fold (fun p sym acc ->
+			(try loop acc (Hashtbl.find relations p)
+			with Not_found -> acc)
+		) symbols [] in
+		List.sort (fun p1 p2 ->
+			let c = compare p1.pfile p2.pfile in
+			if c <> 0 then c else compare p1.pmin p2.pmin
+		) usages
+	) () in
 	Display.ReferencePosition.reset();
 	DisplayException.raise_positions usages
 

src/context/display/syntaxExplorer.ml

@@ -165,23 +165,23 @@ let explore_uncached_modules tctx cs symbols =
 	let cc = CommonCache.get_cache tctx.com in
 	let files = cc#get_files in
 	let modules = cc#get_modules in
-	let t = Timer.timer ["display";"references";"candidates"] in
-	let acc = Hashtbl.fold (fun file_key cfile acc ->
-		let module_name = get_module_name_of_cfile cfile.c_file_path.file cfile in
-		if Hashtbl.mem modules (cfile.c_package,module_name) then
-			acc
-		else try
-			find_in_syntax symbols (cfile.c_package,cfile.c_decls);
-			acc
-		with Exit ->
-			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.g PFinal ("final",cfile.c_package @ [module_name]);
-				m :: acc
-			with _ ->
+	let acc = Timer.time tctx.com.timer_ctx ["display";"references";"candidates"] (fun () ->
+		Hashtbl.fold (fun file_key cfile acc ->
+			let module_name = get_module_name_of_cfile cfile.c_file_path.file cfile in
+			if Hashtbl.mem modules (cfile.c_package,module_name) then
 				acc
-			end
-	) files [] in
-	t();
+			else try
+				find_in_syntax symbols (cfile.c_package,cfile.c_decls);
+				acc
+			with Exit ->
+				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.g PFinal ("final",cfile.c_package @ [module_name]);
+					m :: acc
+				with _ ->
+					acc
+				end
+		) files []
+	) () in
 	acc

src/context/parallel.ml

@@ -6,9 +6,7 @@ let run_parallel_for num_domains ?(chunk_size=0) length f =
 module ParallelArray = struct
 	let iter pool f a =
 		let f' idx = f a.(idx) in
-		let old = Atomic.exchange Timer.in_parallel true in
-		Domainslib.Task.run pool (fun _ -> Domainslib.Task.parallel_for pool ~start:0 ~finish:(Array.length a - 1) ~body:f');
-		Atomic.set Timer.in_parallel old
+		Domainslib.Task.run pool (fun _ -> Domainslib.Task.parallel_for pool ~start:0 ~finish:(Array.length a - 1) ~body:f')
 end
 
 module ParallelSeq = struct

src/context/safeCom.ml

@@ -21,6 +21,7 @@ type t = {
 	exceptions_mutex : Mutex.t;
 	warnings : saved_warning list ref;
 	warnings_mutex : Mutex.t;
+	timer_ctx : Timer.timer_context;
 	curclass : tclass;
 	curfield : tclass_field;
 }
@@ -46,16 +47,16 @@ let add_warning scom w msg p =
 		()
 
 let run_expression_filters_safe scom detail_times filters t =
-	let run com identifier e =
+	let run scom identifier e =
 		try
 			List.fold_left (fun e (filter_name,f) ->
 				try
-					FilterContext.with_timer detail_times filter_name identifier (fun () -> f com e)
+					FilterContext.with_timer scom.timer_ctx detail_times filter_name identifier (fun () -> f scom e)
 				with Failure msg ->
 					Error.raise_typing_error msg e.epos
 			) e filters
 		with exc ->
-			add_exn com exc;
+			add_exn scom exc;
 			e
 	in
 	match t with

src/core/json/genjson.ml

@@ -727,13 +727,13 @@ let create_context ?jsonrpc gm = {
 	request = match jsonrpc with None -> None | Some jsonrpc -> Some (new JsonRequest.json_request jsonrpc)
 }
 
-let generate types file =
-	let t = Timer.timer ["generate";"json";"construct"] in
-	let ctx = create_context GMFull in
-	let json = jarray (List.map (generate_module_type ctx) types) in
-	t();
-	let t = Timer.timer ["generate";"json";"write"] in
-	let ch = open_out_bin file in
-	Json.write_json (output_string ch) json;
-	close_out ch;
-	t()
+let generate timer_ctx types file =
+	let json = Timer.time timer_ctx ["generate";"json";"construct"] (fun () ->
+		let ctx = create_context GMFull in
+		jarray (List.map (generate_module_type ctx) types)
+	) () in
+	Timer.time timer_ctx ["generate";"json";"write"] (fun () ->
+		let ch = open_out_bin file in
+		Json.write_json (output_string ch) json;
+		close_out ch;
+	) ()

src/core/timer.ml

@@ -1,98 +1,76 @@
-(*
-	The Haxe Compiler
-	Copyright (C) 2005-2019  Haxe Foundation
-
-	This program is free software; you can redistribute it and/or
-	modify it under the terms of the GNU General Public License
-	as published by the Free Software Foundation; either version 2
-	of the License, or (at your option) any later version.
-
-	This program is distributed in the hope that it will be useful,
-	but WITHOUT ANY WARRANTY; without even the implied warranty of
-	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-	GNU General Public License for more details.
-
-	You should have received a copy of the GNU General Public License
-	along with this program; if not, write to the Free Software
-	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
- *)
-
-type timer_infos = {
+type timer = {
 	id : string list;
-	mutable start : float list;
-	mutable pauses : float list;
 	mutable total : float;
+	mutable pauses : float;
 	mutable calls : int;
 }
 
-let in_parallel = Atomic.make false
+type timer_context = {
+	mutable current : timer;
+	mutable measure_times : bool;
+	start_time : float;
+	timer_lut : (string list,timer) Hashtbl.t;
+}
 
-let measure_times = ref false
+let make id = {
+	id = id;
+	total = 0.;
+	pauses = 0.;
+	calls = 0;
+}
 
-let get_time = Extc.time
-let htimers = Hashtbl.create 0
+let make_context root_timer = {
+	current = root_timer;
+	timer_lut = Hashtbl.create 0;
+	measure_times = false;
+	start_time = Extc.time();
+}
 
-let new_timer id =
-	let now = get_time() in
-	try
-		let t = Hashtbl.find htimers id in
-		t.start <- now :: t.start;
-		t.pauses <- 0. :: t.pauses;
-		t.calls <- t.calls + 1;
-		t
+let start_timer ctx id =
+	let start = Extc.time () in
+	let old = ctx.current in
+	let timer = try
+		Hashtbl.find ctx.timer_lut id
 	with Not_found ->
-		let t = { id = id; start = [now]; pauses = [0.]; total = 0.; calls = 1; } in
-		Hashtbl.add htimers id t;
-		t
-
-let curtime = ref []
-
-let rec close now t =
-	match !curtime with
-	| [] ->
-		failwith ("Timer " ^ (String.concat "." t.id) ^ " closed while not active")
-	| tt :: rest ->
-		if t == tt then begin
-			match t.start, t.pauses with
-			| start :: rest_start, pauses :: rest_pauses ->
-				let dt = now -. start in
-				t.total <- t.total +. dt -. pauses;
-				t.start <- rest_start;
-				t.pauses <- rest_pauses;
-				curtime := rest;
-				(match !curtime with
-				| [] -> ()
-				| current :: _ ->
-					match current.pauses with
-					| pauses :: rest -> current.pauses <- (dt +. pauses) :: rest
-					| _ -> Globals.die "" __LOC__
-				)
-			| _ -> Globals.die "" __LOC__
-		end else
-			close now tt
-
-let timer id =
-	if !measure_times && not (Atomic.get in_parallel) then (
-		let t = new_timer id in
-		curtime := t :: !curtime;
-		(function() -> close (get_time()) t)
-	) else
-		(fun() -> ())
-
-let current_id() =
-	match !curtime with
-	| [] -> None
-	| t :: _ -> Some t.id
-
-let rec close_times() =
-	let now = get_time() in
-	match !curtime with
-	| [] -> ()
-	| t :: _ -> close now t; close_times()
-
-let close = close (get_time())
+		let timer = make id in
+		Hashtbl.add ctx.timer_lut id timer;
+		timer
+	in
+	timer.calls <- timer.calls + 1;
+	ctx.current <- timer;
+	(fun () ->
+		let now = Extc.time () in
+		let dt = now -. start in
+		timer.total <- timer.total +. dt -. timer.pauses;
+		timer.pauses <- 0.;
+		old.pauses <- old.pauses +. dt;
+		ctx.current <- old
+	)
+
+let start_timer ctx id = match id with
+	| _ :: _ when ctx.measure_times && Domain.is_main_domain () ->
+		start_timer ctx id
+	| _ ->
+		(fun () -> ())
+
+let time ctx id f arg =
+	let close = start_timer ctx id in
+	Std.finally close f arg
+
+let determine_id level base_labels label1 label2 =
+	match level,label2 with
+	| 0,_ -> base_labels
+	| 1,_ -> base_labels @ label1
+	| _,Some label2 -> base_labels @ label1 @ [label2]
+	| _ -> base_labels
+
+let level_from_define defines define =
+	try
+		int_of_string (Define.defined_value defines define)
+	with _ ->
+		0
 
-(* Printing *)
+(* reporting *)
 
 let timer_threshold = 0.01
 
@@ -106,7 +84,7 @@ type timer_node = {
 	mutable children : timer_node list;
 }
 
-let build_times_tree () =
+let build_times_tree ctx =
 	let nodes = Hashtbl.create 0 in
 	let rec root = {
 		name = "";
@@ -158,7 +136,7 @@ let build_times_tree () =
 		let node = loop root timer.id in
 		if not (List.memq node root.children) then
 			root.children <- node :: root.children
-	) htimers;
+	) ctx.timer_lut;
 	let max_name = ref 0 in
 	let max_calls = ref 0 in
 	let rec loop depth node =
@@ -177,8 +155,8 @@ let build_times_tree () =
 	loop 0 root;
 	!max_name,!max_calls,root
 
-let report_times print =
-	let max_name,max_calls,root = build_times_tree () in
+let report_times ctx print =
+	let max_name,max_calls,root = build_times_tree ctx in
 	let max_calls = String.length (string_of_int max_calls) in
 	print (Printf.sprintf "%-*s | %7s |   %% |  p%% | %*s | info" max_name "name" "time(s)" max_calls "#");
 	let sep = String.make (max_name + max_calls + 27) '-' in
@@ -194,24 +172,4 @@ let report_times print =
 	in
 	List.iter (loop 0) root.children;
 	print sep;
-	print_time "total" root
-
-class timer (id : string list) = object(self)
-	method run_finally : 'a . (unit -> 'a) -> (unit -> unit) -> 'a = fun f finally ->
-		let timer = timer id in
-		try
-			let r = f() in
-			timer();
-			finally();
-			r
-		with exc ->
-			timer();
-			finally();
-			raise exc
-
-	method run : 'a . (unit -> 'a) -> 'a = fun f ->
-		self#run_finally f (fun () -> ())
-
-	method nest (name : string) =
-		new timer (id @ [name])
-end
+	print_time "total" root

src/filters/filterContext.ml

@@ -1,12 +1,6 @@
-let with_timer detail_times label identifier f =
-	let label = match detail_times,identifier with
-		| 0,_ -> ["filters"]
-		| 1,_ -> "filters" :: label :: []
-		| _,Some identifier -> "filters" :: label :: identifier :: []
-		| _ -> ["filters"]
-	in
-	let timer = Timer.timer label in
-	Std.finally timer f ()
+let with_timer timer_ctx level label identifier f =
+	let id = Timer.determine_id level ["filters"] [label] identifier in
+	Timer.time timer_ctx id f ()
 
 open Type
 

src/filters/filters.ml

@@ -182,7 +182,7 @@ open FilterContext
 
 let destruction tctx ectx detail_times main locals =
 	let com = tctx.com in
-	with_timer detail_times "type 2" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "type 2" None (fun () ->
 		(* PASS 2: type filters pre-DCE *)
 		List.iter (fun t ->
 			FiltersCommon.remove_generic_base t;
@@ -193,7 +193,7 @@ let destruction tctx ectx detail_times main locals =
 		) com.types;
 	);
 	enter_stage com CDceStart;
-	with_timer detail_times "dce" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "dce" None (fun () ->
 		(* DCE *)
 		let dce_mode = try Common.defined_value com Define.Dce with _ -> "no" in
 		let dce_mode = match dce_mode with
@@ -227,7 +227,7 @@ let destruction tctx ectx detail_times main locals =
 		(fun _ -> commit_features com);
 		(fun _ -> (if com.config.pf_reserved_type_paths <> [] then check_reserved_type_paths com else (fun _ -> ())));
 	] in
-	with_timer detail_times "type 3" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "type 3" None (fun () ->
 		List.iter (fun t ->
 			let tctx = match t with
 				| TClassDecl c ->
@@ -407,7 +407,7 @@ let run_parallel_safe com scom pool f =
 
 let run tctx ectx main before_destruction =
 	let com = tctx.com in
-	let detail_times = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.FilterTimes) with _ -> 0) in
+	let detail_times = Timer.level_from_define com.defines Define.FilterTimes in
 	let new_types = List.filter (fun t ->
 		let cached = is_cached com t in
 		begin match t with
@@ -496,18 +496,18 @@ let run tctx ectx main before_destruction =
 		);
 		locals
 	) in
-	with_timer detail_times "callbacks" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_before_save;
 	);
 	enter_stage com CSaveStart;
-	with_timer detail_times "save state" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "save state" None (fun () ->
 		List.iter (fun mt ->
 			update_cache_dependencies ~close_monomorphs:true com mt;
 			save_class_state com mt
 		) new_types;
 	);
 	enter_stage com CSaveDone;
-	with_timer detail_times "callbacks" None (fun () ->
+	with_timer tctx.com.timer_ctx detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_after_save;
 	);
 	before_destruction();

src/filters/filtersCommon.ml

@@ -42,7 +42,7 @@ let run_expression_filters ?(ignore_processed_status=false) ctx detail_times fil
 	let run (ctx : typer) identifier e =
 		List.fold_left (fun e (filter_name,f) ->
 			(try
-				FilterContext.with_timer detail_times filter_name identifier (fun () -> f ctx e)
+				FilterContext.with_timer ctx.com.timer_ctx detail_times filter_name identifier (fun () -> f ctx e)
 			with Failure msg ->
 				com.error msg e.epos;
 				e)

src/generators/gctx.ml

@@ -31,6 +31,7 @@ type t = {
 	native_libs : NativeLibraries.native_library_base list;
 	include_files : (string * string) list;
 	std : tclass; (* TODO: I would prefer to not have this here, have to check default_cast *)
+	timer_ctx : Timer.timer_context;
 }
 
 let defined com s =

src/generators/gencpp.ml

@@ -343,7 +343,7 @@ let generate_source ctx =
          let acc_decls        = (Enum enum) :: acc.decls in
          let acc_boot_enums   = enum_def.e_path :: acc.boot_enums in
          let acc_exe_classes  = (enum_def.e_path, deps, cur) :: acc.exe_classes in
-         
+
          { acc with decls = acc_decls; boot_enums = acc_boot_enums; exe_classes = acc_exe_classes; ids = ids }
       | _ ->
          acc
@@ -436,23 +436,23 @@ let generate_source ctx =
    write_build_data common_ctx (common_ctx.file ^ "/Build.xml") srcctx.exe_classes !main_deps (srcctx.boot_enums@ srcctx.boot_classes) srcctx.build_xml srcctx.extern_src output_name;
    write_build_options common_ctx (common_ctx.file ^ "/Options.txt") common_ctx.defines.Define.values;
    if ( not (Gctx.defined common_ctx Define.NoCompilation) ) then begin
-      let t = Timer.timer ["generate";"cpp";"native compilation"] in
-      let old_dir = Sys.getcwd() in
-      Sys.chdir common_ctx.file;
-      let cmd = ref ["run"; "hxcpp"; "Build.xml"; "haxe"] in
-	  if (common_ctx.debug) then cmd := !cmd @ ["-Ddebug"];
-      PMap.iter ( fun name value -> match name with
-         | "true" | "sys" | "dce" | "cpp" | "debug" -> ();
-         | _ -> cmd := !cmd @ [Printf.sprintf "-D%s=\"%s\"" name (escape_command value)];
-      ) common_ctx.defines.values;
-      common_ctx.class_paths#iter (fun path ->
-		let path = path#path in
-		cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]
-	  );
-      common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
-      if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
-      Sys.chdir old_dir;
-      t()
+      Timer.time common_ctx.timer_ctx ["generate";"cpp";"native compilation"] (fun () ->
+		let old_dir = Sys.getcwd() in
+		Sys.chdir common_ctx.file;
+		let cmd = ref ["run"; "hxcpp"; "Build.xml"; "haxe"] in
+		if (common_ctx.debug) then cmd := !cmd @ ["-Ddebug"];
+		PMap.iter ( fun name value -> match name with
+			| "true" | "sys" | "dce" | "cpp" | "debug" -> ();
+			| _ -> cmd := !cmd @ [Printf.sprintf "-D%s=\"%s\"" name (escape_command value)];
+		) common_ctx.defines.values;
+		common_ctx.class_paths#iter (fun path ->
+			let path = path#path in
+			cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]
+		);
+		common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
+		if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
+		Sys.chdir old_dir;
+	  ) ()
    end
 
 let generate common_ctx =
@@ -462,7 +462,7 @@ let generate common_ctx =
    if (Gctx.defined common_ctx Define.Cppia) then begin
       let ctx = new_context common_ctx debug_level (ref PMap.empty) StringMap.empty super_deps constructor_deps in
       CppCppia.generate_cppia ctx
-   end else begin   
+   end else begin
       let ctx = new_context common_ctx debug_level (ref PMap.empty) (create_member_types common_ctx) super_deps constructor_deps in
       generate_source ctx
    end

src/generators/genhl.ml

@@ -3432,7 +3432,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 	ctx.m <- old;
 	Hashtbl.add ctx.defined_funs fidx ();
 	let f = if ctx.optimize && (gen_content = None || name <> ("","")) then begin
-		let t = Timer.timer ["generate";"hl";"opt"] in
+		let t = Timer.start_timer ctx.com.timer_ctx ["generate";"hl";"opt"] in
 		let f = Hlopt.optimize ctx.dump_out (DynArray.get ctx.cstrings.arr) hlf f in
 		t();
 		f
@@ -4284,7 +4284,7 @@ let generate com =
 		check ctx;
 		Hlinterp.check com.error code;
 	end;
-	let t = Timer.timer ["generate";"hl";"write"] in
+	let t = Timer.start_timer com.timer_ctx ["generate";"hl";"write"] in
 
 	let escape_command s =
 		let b = Buffer.create 0 in
@@ -4302,7 +4302,7 @@ let generate com =
 			Gctx.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version);
 		end;
 		Hl2c.write_c com com.file code gnames;
-		let t = Timer.timer ["nativecompile";"hl"] in
+		let t = Timer.start_timer com.timer_ctx ["nativecompile";"hl"] in
 		if not (Gctx.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed";
 		t();
 	end else begin
@@ -4322,7 +4322,7 @@ let generate com =
 	end;
 	if Gctx.defined com Define.Interp then
 		try
-			let t = Timer.timer ["generate";"hl";"interp"] in
+			let t = Timer.start_timer com.timer_ctx ["generate";"hl";"interp"] in
 			let ctx = Hlinterp.create true in
 			Hlinterp.add_code ctx code;
 			t();

src/generators/genjvm.ml

@@ -72,7 +72,6 @@ type generation_context = {
 	closure_paths : (path * string * jsignature,path) Hashtbl.t; (* guarded by mutexes.closure_lookup *)
 	enum_paths : (path,unit) Hashtbl.t; (* final after preprocessing *)
 	detail_times : bool;
-	mutable timer : Timer.timer;
 	mutable (* final after preprocessing *) typedef_interfaces : jsignature typedef_interfaces;
 	jar_compression_level : int;
 	dynamic_level : int;
@@ -105,10 +104,8 @@ let run_timed gctx detail name f =
 	if detail && not gctx.detail_times then
 		f()
 	else begin
-		let sub = gctx.timer#nest name in
-		let old = gctx.timer in
-		gctx.timer <- sub;
-		sub#run_finally f (fun () -> gctx.timer <- old)
+		let timer_ctx = gctx.gctx.timer_ctx in
+		Timer.time timer_ctx (timer_ctx.current.id @ [name]) f ()
 	end
 
 class file_output
@@ -356,12 +353,12 @@ let write_class gctx path jc =
 		| (sl,s) -> String.concat "/" sl ^ "/" ^ s
 	in
 	let path = dir ^ ".class" in
-	let t = Timer.timer ["jvm";"write"] in
-	let ch = IO.output_bytes() in
-	JvmWriter.write_jvm_class ch jc;
-	let bytes = Bytes.unsafe_to_string (IO.close_out ch) in
-	Mutex.protect gctx.mutexes.write_class (fun () -> gctx.out#add_entry bytes path);
-	t()
+	Timer.time gctx.gctx.timer_ctx ["generate";"jvm";"write"] (fun () ->
+		let ch = IO.output_bytes() in
+		JvmWriter.write_jvm_class ch jc;
+		let bytes = Bytes.unsafe_to_string (IO.close_out ch) in
+		Mutex.protect gctx.mutexes.write_class (fun () -> gctx.out#add_entry bytes path);
+	) ()
 
 let is_const_int_pattern case =
 	List.for_all (fun e -> match e.eexpr with
@@ -3186,7 +3183,6 @@ let generate jvm_flag gctx =
 			export_debug = true;
 		};
 		detail_times = Gctx.raw_defined gctx "jvm_times";
-		timer = new Timer.timer ["generate";"java"];
 		jar_compression_level = compression_level;
 		dynamic_level = dynamic_level;
 		functional_interfaces = [];

src/generators/genswf.ml

@@ -614,24 +614,24 @@ let generate swf_header swf_libs flash_version com =
 		{header with h_frame_count = header.h_frame_count + 1},loop tags
 	| _ -> swf in
 	(* write swf/swc *)
-	let t = Timer.timer ["write";"swf"] in
-	let level = (try int_of_string (Gctx.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in
-	SwfParser.init Extc.input_zip (Extc.output_zip ~level);
-	(match swc with
-	| Some cat ->
-		let ch = IO.output_strings() in
-		Swf.write ch swf;
-		let swf = IO.close_out ch in
-		let z = Zip.open_out file in
-		Zip.add_entry (!cat) z "catalog.xml";
-		Zip.add_entry (match swf with [s] -> s | _ -> failwith "SWF too big for SWC") z ~level:0 "library.swf";
-		Zip.close_out z
-	| None ->
-		let ch = IO.output_channel (open_out_bin file) in
-		Swf.write ch swf;
-		IO.close_out ch;
-	);
-	t()
+	Timer.time com.timer_ctx ["write";"swf"] (fun () ->
+		let level = (try int_of_string (Gctx.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in
+		SwfParser.init Extc.input_zip (Extc.output_zip ~level);
+		(match swc with
+		| Some cat ->
+			let ch = IO.output_strings() in
+			Swf.write ch swf;
+			let swf = IO.close_out ch in
+			let z = Zip.open_out file in
+			Zip.add_entry (!cat) z "catalog.xml";
+			Zip.add_entry (match swf with [s] -> s | _ -> failwith "SWF too big for SWC") z ~level:0 "library.swf";
+			Zip.close_out z
+		| None ->
+			let ch = IO.output_channel (open_out_bin file) in
+			Swf.write ch swf;
+			IO.close_out ch;
+		);
+	) ()
 
 ;;
 SwfParser.init Extc.input_zip Extc.output_zip;

src/macro/eval/evalContext.ml

@@ -273,6 +273,7 @@ and context = {
 	mutable curapi : value MacroApi.compiler_api;
 	mutable type_cache : Type.module_type IntMap.t;
 	overrides : (Globals.path * string,bool) Hashtbl.t;
+	timer_ctx : Timer.timer_context;
 	(* prototypes *)
 	mutable array_prototype : vprototype;
 	mutable string_prototype : vprototype;
@@ -435,7 +436,7 @@ let create_env_info static pfile pfile_key kind capture_infos num_locals num_cap
 let push_environment ctx info =
 	let eval = get_eval ctx in
 	let timer = if ctx.detail_times then
-		Timer.timer ["macro";"execution";kind_name eval info.kind]
+		Timer.start_timer ctx.timer_ctx ["macro";"execution";kind_name eval info.kind]
 	else
 		no_timer
 	in

src/macro/eval/evalJit.ml

@@ -699,7 +699,7 @@ and get_env_creation jit static file info =
 	create_env_info static file (jit.ctx.file_keys#get file) info jit.capture_infos jit.max_num_locals (Hashtbl.length jit.captures)
 
 let jit_timer ctx f =
-	Std.finally (Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"]) f ()
+	Timer.time ctx.timer_ctx [(if ctx.is_macro then "macro" else "interp");"jit"] f ()
 
 (* Creates a [EvalValue.vfunc] of function [tf], which can be [static] or not. *)
 let jit_tfunction ctx key_type key_field tf static pos =

src/macro/eval/evalMain.ml

@@ -36,7 +36,6 @@ open Extlib_leftovers
 (* Create *)
 
 let create com api is_macro =
-	let t = Timer.timer [(if is_macro then "macro" else "interp");"create"] in
 	incr GlobalState.sid;
 	let builtins = match !GlobalState.stdlib with
 		| None ->
@@ -126,6 +125,7 @@ let create com api is_macro =
 		eval = eval;
 		evals = evals;
 		exception_stack = [];
+		timer_ctx = com.timer_ctx;
 		max_stack_depth = int_of_string (Common.defined_value_safe ~default:"1000" com Define.EvalCallStackDepth);
 		max_print_depth = int_of_string (Common.defined_value_safe ~default:"5" com Define.EvalPrintDepth);
 		print_indentation = match Common.defined_value_safe com Define.EvalPrettyPrint
@@ -160,9 +160,11 @@ let create com api is_macro =
 			Printf.eprintf "%s\n" msg;
 			exit 2
 	);
-	t();
 	ctx
 
+let create com api is_macro =
+	Timer.time com.Common.timer_ctx [(if is_macro then "macro" else "interp");"create"] (create com api) is_macro
+
 (* API for macroContext.ml *)
 
 let call_path ctx path f vl api =

src/macro/eval/evalPrototype.ml

@@ -304,7 +304,6 @@ let get_object_prototype ctx l =
 	proto,l
 
 let add_types ctx types ready =
-	let t = Timer.timer [(if ctx.is_macro then "macro" else "interp");"add_types"] in
 	let new_types = List.filter (fun mt ->
 		let inf = Type.t_infos mt in
 		let key = path_hash inf.mt_path in
@@ -368,5 +367,7 @@ let add_types ctx types ready =
 			ctx.static_prototypes#add_init proto non_persistent_delays;
 	) fl_static;
 	(* 4. Initialize static fields. *)
-	DynArray.iter (fun (proto,delays) -> List.iter (fun (_,f) -> f proto) delays) fl_static_init;
-	t()
+	DynArray.iter (fun (proto,delays) -> List.iter (fun (_,f) -> f proto) delays) fl_static_init
+
+let add_types ctx types ready =
+	Timer.time ctx.timer_ctx [(if ctx.is_macro then "macro" else "interp");"add_types"] (add_types ctx types) ready

src/macro/macroApi.ml

@@ -2383,8 +2383,10 @@ let macro_api ccom get_api =
 			vnull
 		);
 		"timer", vfun1 (fun id ->
-			let full_id = (Option.default [] (Timer.current_id())) @ [decode_string id] in
-			let stop = Timer.timer full_id in
+			let com = ccom() in
+			let full_id = com.timer_ctx.current.id @ [decode_string id] in
+			(* TIMERTODO: Exposing this seems potentially dangerous... Have to at least document. *)
+			let stop = Timer.start_timer com.timer_ctx full_id in
 			vfun0 (fun() -> stop(); vnull)
 		);
 		"map_anon_ref", vfun2 (fun a_ref fn ->

src/optimization/analyzer.ml

@@ -970,16 +970,9 @@ module Run = struct
 	open AnalyzerConfig
 	open Graph
 
-	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
-		Std.finally timer f ()
+	let with_timer timer_ctx level identifier s f =
+		let id = Timer.determine_id level ["analyzer"] s identifier in
+		Timer.time timer_ctx id f ()
 
 	let create_analyzer_context (com : Common.context) config identifier e =
 		let g = Graph.create e.etype e.epos in
@@ -997,7 +990,7 @@ 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 identifier s f
+				with_timer com.timer_ctx config.detail_times (Some identifier) s f
 			);
 			identifier = identifier;
 			entry = g.g_unreachable;
@@ -1204,9 +1197,9 @@ module Run = struct
 
 	let run_on_types com pool types =
 		let config = get_base_config com in
-		with_timer config.detail_times "" ["other"] (fun () ->
+		with_timer com.timer_ctx config.detail_times None ["other"] (fun () ->
 			if config.optimize && config.purity_inference then
-				with_timer config.detail_times "" ["optimize";"purity-inference"] (fun () -> Purity.infer com);
+				with_timer com.timer_ctx config.detail_times None ["optimize";"purity-inference"] (fun () -> Purity.infer com);
 			let exc_out = Atomic.make None in
 			Parallel.ParallelArray.iter pool (run_on_type com exc_out pool config) (Array.of_list types);
 			check_exc_out exc_out

src/optimization/analyzerConfig.ml

@@ -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 = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.AnalyzerTimes) with _ -> 0);
+		detail_times = Timer.level_from_define com.defines Define.AnalyzerTimes;
 		user_var_fusion = (match com.platform with Flash | Jvm -> 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/typing/macroContext.ml

@@ -56,11 +56,12 @@ let safe_decode com v expected t p f =
 			raise_decode_error (Printf.sprintf "Expected %s but got %s" expected (Interp.value_string v))
 
 
-let macro_timer com l =
-	Timer.timer (if Common.defined com Define.MacroTimes then ("macro" :: l) else ["macro"])
+let macro_timer timer_ctx level label identifier f arg =
+	let id = Timer.determine_id level ["macro"] [label] identifier in
+	Timer.time timer_ctx id f arg
 
 let typing_timer ctx need_type f =
-	let t = Timer.timer ["typing"] in
+	let t = Timer.start_timer ctx.com.timer_ctx ["typing"] in
 	let ctx = if need_type && ctx.pass < PTypeField then begin
 		enter_field_typing_pass ctx.g ("typing_timer",[]);
 		TyperManager.clone_for_expr ctx ctx.e.curfun false
@@ -94,6 +95,7 @@ let typing_timer ctx need_type f =
 		raise e
 
 let make_macro_com_api com mcom p =
+	let timer_level = Timer.level_from_define com.defines Define.MacroTimes in
 	let parse_metadata s p =
 		try
 			match ParserEntry.parse_string Grammar.parse_meta com.defines s null_pos raise_typing_error false with
@@ -132,30 +134,22 @@ let make_macro_com_api com mcom p =
 		);
 		after_init_macros = (fun f ->
 			com.callbacks#add_after_init_macros (fun () ->
-				let t = macro_timer com ["afterInitMacros"] in
-				f ();
-				t()
+				macro_timer com.timer_ctx timer_level "afterInitMacros" None f ();
 			)
 		);
 		after_typing = (fun f ->
 			com.callbacks#add_after_typing (fun tl ->
-				let t = macro_timer com ["afterTyping"] in
-				f tl;
-				t()
+				macro_timer com.timer_ctx timer_level "afterTyping" None f tl;
 			)
 		);
 		on_generate = (fun f b ->
 			(if b then com.callbacks#add_before_save else com.callbacks#add_after_save) (fun() ->
-				let t = macro_timer com ["onGenerate"] in
-				f (List.map type_of_module_type com.types);
-				t()
+				macro_timer com.timer_ctx timer_level "onGenerate"None f (List.map type_of_module_type com.types);
 			)
 		);
 		after_generate = (fun f ->
 			com.callbacks#add_after_generation (fun() ->
-				let t = macro_timer com ["afterGenerate"] in
-				f();
-				t()
+				macro_timer com.timer_ctx timer_level "afterGenerate" None f ();
 			)
 		);
 		on_type_not_found = (fun f ->
@@ -603,88 +597,89 @@ let init_macro_interp mctx mint =
 	macro_interp_cache := Some mint
 
 and flush_macro_context mint mctx =
-	let t = macro_timer mctx.com ["flush"] in
-	let mctx = (match mctx.g.macros with None -> die "" __LOC__ | Some (_,mctx) -> mctx) in
-	let main_module = Finalization.maybe_load_main mctx in
-	Finalization.finalize mctx;
-	let _, types, modules = Finalization.generate mctx main_module in
-	mctx.com.types <- types;
-	mctx.com.Common.modules <- modules;
-	let ectx = Exceptions.create_exception_context mctx in
-
-	(*
-		some filters here might cause side effects that would break compilation server.
-		let's save the minimal amount of information we need
-	*)
-	let minimal_restore t =
-		if (t_infos t).mt_module.m_extra.m_processed = 0 then
-			(t_infos t).mt_module.m_extra.m_processed <- mctx.com.compilation_step;
+	let f () =
+		let mctx = (match mctx.g.macros with None -> die "" __LOC__ | Some (_,mctx) -> mctx) in
+		let main_module = Finalization.maybe_load_main mctx in
+		Finalization.finalize mctx;
+		let _, types, modules = Finalization.generate mctx main_module in
+		mctx.com.types <- types;
+		mctx.com.Common.modules <- modules;
+		let ectx = Exceptions.create_exception_context mctx in
+		(*
+			some filters here might cause side effects that would break compilation server.
+			let's save the minimal amount of information we need
+		*)
+		let minimal_restore t =
+			if (t_infos t).mt_module.m_extra.m_processed = 0 then
+				(t_infos t).mt_module.m_extra.m_processed <- mctx.com.compilation_step;
 
-		match t with
-		| TClassDecl c ->
-			let mk_field_restore f =
-				let e = f.cf_expr in
-				(fun () -> f.cf_expr <- e)
-			in
-			let meta = c.cl_meta
-			and path = c.cl_path
-			and field_restores = List.map mk_field_restore c.cl_ordered_fields
-			and static_restores = List.map mk_field_restore c.cl_ordered_statics
-			and ctor_restore = Option.map mk_field_restore c.cl_constructor
+			match t with
+			| TClassDecl c ->
+				let mk_field_restore f =
+					let e = f.cf_expr in
+					(fun () -> f.cf_expr <- e)
+				in
+				let meta = c.cl_meta
+				and path = c.cl_path
+				and field_restores = List.map mk_field_restore c.cl_ordered_fields
+				and static_restores = List.map mk_field_restore c.cl_ordered_statics
+				and ctor_restore = Option.map mk_field_restore c.cl_constructor
+				in
+				c.cl_restore <- (fun() ->
+					c.cl_meta <- meta;
+					c.cl_path <- path;
+					c.cl_descendants <- [];
+					Option.may (fun fn -> fn()) ctor_restore;
+					List.iter (fun fn -> fn()) field_restores;
+					List.iter (fun fn -> fn()) static_restores;
+				);
+			| _ ->
+				()
+		in
+		(* Apply native paths for externs only *)
+		let maybe_apply_native_paths t =
+			let apply_native = match t with
+				| TClassDecl { cl_kind = KAbstractImpl a } -> a.a_extern && a.a_enum
+				| TEnumDecl e -> has_enum_flag e EnExtern
+				| _ -> false
 			in
-			c.cl_restore <- (fun() ->
-				c.cl_meta <- meta;
-				c.cl_path <- path;
-				c.cl_descendants <- [];
-				Option.may (fun fn -> fn()) ctor_restore;
-				List.iter (fun fn -> fn()) field_restores;
-				List.iter (fun fn -> fn()) static_restores;
+			if apply_native then Native.apply_native_paths t
+		in
+		let scom_from_tctx tctx =
+			let scom = to_safe_com mctx.com in
+			let scom = {scom with curclass = tctx.c.curclass; curfield = tctx.f.curfield} in (* This isn't great *)
+			scom
+		in
+		let cv_wrapper_impl = CapturedVars.get_wrapper_implementation mctx.com in
+		let expr_filters = [
+			"handle_abstract_casts",AbstractCast.handle_abstract_casts;
+			"local_statics",(fun tctx ->
+				let scom = scom_from_tctx tctx in
+				LocalStatic.run scom
 			);
-		| _ ->
-			()
-	in
-	(* Apply native paths for externs only *)
-	let maybe_apply_native_paths t =
-		let apply_native = match t with
-			| TClassDecl { cl_kind = KAbstractImpl a } -> a.a_extern && a.a_enum
-			| TEnumDecl e -> has_enum_flag e EnExtern
-			| _ -> false
+			"Exceptions",(fun _ -> Exceptions.filter ectx);
+			"captured_vars",(fun tctx ->
+				let scom = scom_from_tctx tctx in
+				CapturedVars.captured_vars scom cv_wrapper_impl
+			);
+		] in
+		let type_filters = [
+			FiltersCommon.remove_generic_base;
+			Exceptions.patch_constructors mctx ectx;
+			(fun mt -> AddFieldInits.add_field_inits mctx.c.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt);
+			Filters.update_cache_dependencies ~close_monomorphs:false mctx.com;
+			minimal_restore;
+			maybe_apply_native_paths
+		] in
+		let ready = fun t ->
+			FiltersCommon.apply_filters_once mctx expr_filters t;
+			List.iter (fun f -> f t) type_filters
 		in
-		if apply_native then Native.apply_native_paths t
+		(try Interp.add_types mint types ready
+		with Error err -> raise (Fatal_error err));
 	in
-	let scom_from_tctx tctx =
-		let scom = to_safe_com mctx.com in
-		let scom = {scom with curclass = tctx.c.curclass; curfield = tctx.f.curfield} in (* This isn't great *)
-		scom
-	in
-	let cv_wrapper_impl = CapturedVars.get_wrapper_implementation mctx.com in
-	let expr_filters = [
-		"handle_abstract_casts",AbstractCast.handle_abstract_casts;
-		"local_statics",(fun tctx ->
-			let scom = scom_from_tctx tctx in
-			LocalStatic.run scom
-		);
-		"Exceptions",(fun _ -> Exceptions.filter ectx);
-		"captured_vars",(fun tctx ->
-			let scom = scom_from_tctx tctx in
-			CapturedVars.captured_vars scom cv_wrapper_impl
-		);
-	] in
-	let type_filters = [
-		FiltersCommon.remove_generic_base;
-		Exceptions.patch_constructors mctx ectx;
-		(fun mt -> AddFieldInits.add_field_inits mctx.c.curclass.cl_path (RenameVars.init mctx.com) mctx.com mt);
-		Filters.update_cache_dependencies ~close_monomorphs:false mctx.com;
-		minimal_restore;
-		maybe_apply_native_paths
-	] in
-	let ready = fun t ->
-		FiltersCommon.apply_filters_once mctx expr_filters t;
-		List.iter (fun f -> f t) type_filters
-	in
-	(try Interp.add_types mint types ready
-	with Error err -> t(); raise (Fatal_error err));
-	t()
+	let timer_level = Timer.level_from_define mctx.com.defines Define.MacroTimes in
+	macro_timer mctx.com.timer_ctx timer_level "flush" None f ()
 
 let create_macro_interp api mctx =
 	let com2 = mctx.com in
@@ -781,48 +776,43 @@ let load_macro_module mctx com cpath display p =
 	}; *)
 	mloaded,(fun () -> mctx.com.display <- old)
 
-let load_macro'' com mctx display cpath f p =
+let load_macro'' com mctx display cpath fname p =
 	let mint = Interp.get_ctx() in
-	try mctx.com.cached_macros#find (cpath,f) with Not_found ->
-		let t = macro_timer com ["typing";s_type_path cpath ^ "." ^ f] in
-		let mpath, sub = (match List.rev (fst cpath) with
-			| name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath)
-			| _ -> cpath, None
-		) in
-		let mloaded,restore = load_macro_module mctx com mpath display p in
-		let cl, meth =
-			try
-				if sub <> None || mloaded.m_path <> cpath then raise Not_found;
-				match mloaded.m_statics with
-				| None -> raise Not_found
-				| Some c ->
-					Finalization.finalize mctx;
-					c, PMap.find f c.cl_statics
-			with Not_found ->
-				let name = Option.default (snd mpath) sub in
-				let path = fst mpath, name in
-				let mt = try List.find (fun t2 -> (t_infos t2).mt_path = path) mloaded.m_types with Not_found -> raise_typing_error_ext (make_error (Type_not_found (mloaded.m_path,name,Not_defined)) p) in
-				match mt with
-				| TClassDecl c ->
-					Finalization.finalize mctx;
-					c, (try PMap.find f c.cl_statics with Not_found -> raise_typing_error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p)
-				| _ -> raise_typing_error "Macro should be called on a class" p
+	let timer_level = Timer.level_from_define com.defines Define.MacroTimes in
+	try
+		mctx.com.cached_macros#find (cpath,fname)
+	with Not_found ->
+		let f () =
+			let mpath, sub = (match List.rev (fst cpath) with
+				| name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath)
+				| _ -> cpath, None
+			) in
+			let mloaded,restore = load_macro_module mctx com mpath display p in
+			let cl, meth =
+				try
+					if sub <> None || mloaded.m_path <> cpath then raise Not_found;
+					match mloaded.m_statics with
+					| None -> raise Not_found
+					| Some c ->
+						Finalization.finalize mctx;
+						c, PMap.find fname c.cl_statics
+				with Not_found ->
+					let name = Option.default (snd mpath) sub in
+					let path = fst mpath, name in
+					let mt = try List.find (fun t2 -> (t_infos t2).mt_path = path) mloaded.m_types with Not_found -> raise_typing_error_ext (make_error (Type_not_found (mloaded.m_path,name,Not_defined)) p) in
+					match mt with
+					| TClassDecl c ->
+						Finalization.finalize mctx;
+						c, (try PMap.find fname c.cl_statics with Not_found -> raise_typing_error ("Method " ^ fname ^ " not found on class " ^ s_type_path cpath) p)
+					| _ -> raise_typing_error "Macro should be called on a class" p
+			in
+			let meth = (match follow meth.cf_type with TFun (args,ret) -> (args,ret,cl,meth),mloaded | _ -> raise_typing_error "Macro call should be a method" p) in
+			restore();
+			if not com.is_macro_context then flush_macro_context mint mctx;
+			mctx.com.cached_macros#add (cpath,fname) meth;
+			meth
 		in
-		let meth = (match follow meth.cf_type with TFun (args,ret) -> (args,ret,cl,meth),mloaded | _ -> raise_typing_error "Macro call should be a method" p) in
-		restore();
-		if not com.is_macro_context then flush_macro_context mint mctx;
-		mctx.com.cached_macros#add (cpath,f) meth;
-		(* mctx.m <- {
-			curmod = null_module;
-			import_resolution = new resolution_list ["import";s_type_path cpath];
-			own_resolution = None;
-			enum_with_type = None;
-			module_using = [];
-			import_statements = [];
-			is_display_file = false;
-		}; *)
-		t();
-		meth
+		macro_timer com.timer_ctx timer_level "typing" (Some (s_type_path cpath ^ "." ^ fname)) f ()
 
 let load_macro' ctx display cpath f p =
 	(* TODO: The only reason this nonsense is here is because this is the signature
@@ -830,12 +820,11 @@ let load_macro' ctx display cpath f p =
 	   voodoo stuff in displayToplevel.ml *)
 	fst (load_macro'' ctx.com (get_macro_context ctx) display cpath f p)
 
-let do_call_macro com api cpath f args p =
-	let t = macro_timer com ["execution";s_type_path cpath ^ "." ^ f] in
+let do_call_macro com api cpath name args p =
 	incr stats.s_macros_called;
-	let r = Interp.call_path (Interp.get_ctx()) ((fst cpath) @ [snd cpath]) f args api in
-	t();
-	r
+	let timer_level = Timer.level_from_define com.defines Define.MacroTimes in
+	let f = Interp.call_path (Interp.get_ctx()) ((fst cpath) @ [snd cpath]) name args in
+	macro_timer com.timer_ctx timer_level "execution" (Some (s_type_path cpath ^ "." ^ name)) f api
 
 let load_macro ctx com mctx api display cpath f p =
 	let meth,mloaded = load_macro'' com mctx display cpath f p in

src/typing/nullSafety.ml

@@ -1658,18 +1658,19 @@ class class_checker cls immediate_execution report =
 	Run null safety checks.
 *)
 let run (com:Common.context) (types:module_type list) =
-	let timer = Timer.timer ["null safety"] in
-	let report = { sr_errors = [] } in
-	let immediate_execution = new immediate_execution in
-	let traverse module_type =
-		match module_type with
-			| TEnumDecl enm -> ()
-			| TTypeDecl typedef -> ()
-			| TAbstractDecl abstr -> ()
-			| TClassDecl cls -> (new class_checker cls immediate_execution report)#check
-	in
-	List.iter traverse types;
-	timer();
+	let report = Timer.time com.timer_ctx ["null safety"] (fun () ->
+		let report = { sr_errors = [] } in
+		let immediate_execution = new immediate_execution in
+		let traverse module_type =
+			match module_type with
+				| TEnumDecl enm -> ()
+				| TTypeDecl typedef -> ()
+				| TAbstractDecl abstr -> ()
+				| TClassDecl cls -> (new class_checker cls immediate_execution report)#check
+		in
+		List.iter traverse types;
+		report;
+	) () in
 	match com.callbacks#get_null_safety_report with
 		| [] ->
 			List.iter (fun err -> Common.display_error com err.sm_msg err.sm_pos) (List.rev report.sr_errors)

src/typing/typeload.ml

@@ -206,10 +206,6 @@ let load_type_def ctx p t =
 	with Not_found ->
 		load_type_def' ctx t.tpackage t.tname tname p
 
-(* let load_type_def ctx p t =
-	let timer = Timer.timer ["typing";"load_type_def"] in
-	Std.finally timer (load_type_def ctx p) t *)
-
 let generate_args_meta com cls_opt add_meta args =
 	let values = List.fold_left (fun acc ((name,p),_,_,_,eo) -> match eo with Some e -> ((name,p,NoQuotes),e) :: acc | _ -> acc) [] args in
 	(match values with

src/typing/typeloadModule.ml

@@ -731,10 +731,6 @@ let type_module com g mpath file ?(dont_check_path=false) ?(is_extern=false) tde
 	if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Naming.check_module_path ctx_m.com m.m_path p;
 	m
 
-(* let type_module ctx mpath file ?(is_extern=false) tdecls p =
-	let timer = Timer.timer ["typing";"type_module"] in
-	Std.finally timer (type_module ctx mpath file ~is_extern tdecls) p *)
-
 class hxb_reader_api_typeload
 	(com : context)
 	(g : typer_globals)
@@ -781,7 +777,7 @@ let rec load_hxb_module com g path p =
 	let read file bytes string_pool =
 		try
 			let api = (new hxb_reader_api_typeload com g load_module' p :> HxbReaderApi.hxb_reader_api) in
-			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats string_pool (Common.defined com Define.HxbTimes) in
+			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats string_pool (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 			let read = reader#read api bytes in
 			let m = read EOT in
 			delay g PConnectField (fun () ->
@@ -853,8 +849,4 @@ let load_module ?(origin:module_dep_origin = MDepFromTyping) ctx m p =
 	if ctx.pass = PTypeField then flush_pass ctx.g PConnectField ("load_module",fst m @ [snd m]);
 	m2
 
-(* let load_module ctx m p =
-	let timer = Timer.timer ["typing";"load_module"] in
-	Std.finally timer (load_module ctx m) p *)
-
 ;;

src/typing/typeloadParse.ml

@@ -31,17 +31,14 @@ open Error
 exception DisplayInMacroBlock
 
 let parse_file_from_lexbuf com file p lexbuf =
-	let t = Timer.timer ["parsing"] in
 	Lexer.init file;
 	incr stats.s_files_parsed;
 	let parse_result = try
 		ParserEntry.parse Grammar.parse_file com.defines lexbuf file
 	with
 		| Sedlexing.MalFormed ->
-			t();
 			raise_typing_error "Malformed file. Source files must be encoded with UTF-8." (file_pos file)
 		| e ->
-			t();
 			raise e
 	in
 	begin match !Parser.display_mode,parse_result with
@@ -52,9 +49,11 @@ let parse_file_from_lexbuf com file p lexbuf =
 		| _ ->
 			()
 	end;
-	t();
 	parse_result
 
+let parse_file_from_lexbuf com file p lexbuf =
+	Timer.time com.timer_ctx ["parsing";file] (parse_file_from_lexbuf com file p) lexbuf
+
 let parse_file_from_string com file p string =
 	parse_file_from_lexbuf com file p (Sedlexing.Utf8.from_string string)
 
@@ -143,10 +142,6 @@ let resolve_module_file com m remap p =
 		com.module_to_file#add m rfile;
 		rfile
 
-(* let resolve_module_file com m remap p =
-	let timer = Timer.timer ["typing";"resolve_module_file"] in
-	Std.finally timer (resolve_module_file com m remap) p *)
-
 module ConditionDisplay = struct
 	open ParserEntry
 	open DisplayPosition
@@ -341,8 +336,4 @@ let parse_module com m p =
 			| EImport _ | EUsing _ -> acc
 		) [(EImport (List.map (fun s -> s,null_pos) (!remap @ [snd m]),INormal),null_pos)] decls)
 	else
-		decls
-
-(* let parse_module ctx m p =
-	let timer = Timer.timer ["typing";"parse_module"] in
-	Std.finally timer (parse_module ctx m) p *)
+		decls

src/typing/typerDisplay.ml

@@ -540,6 +540,56 @@ and display_expr ctx e_ast e dk mode with_type p =
 		in
 		raise_fields fields (CRField(item,e.epos,iterator,keyValueIterator)) (make_subject None (DisplayPosition.display_position#with_pos p))
 
+let filter_ctors ctx r =
+	List.filter (fun item ->
+		let is_private_to_current_module mt =
+			(* Remove the _Module nonsense from the package *)
+			let pack = List.rev (List.tl (List.rev mt.pack)) in
+			(pack,mt.module_name) = ctx.m.curmod.m_path
+		in
+		match item.ci_kind with
+		| ITType({kind = (Class | Abstract | TypeAlias)} as mt,_) when not mt.is_private || is_private_to_current_module mt ->
+			begin match mt.has_constructor with
+			| Yes -> true
+			| YesButPrivate ->
+				if (Meta.has Meta.PrivateAccess ctx.f.meta) then true
+				else
+					begin
+						match ctx.c.curclass.cl_kind with
+						| KAbstractImpl { a_path = (pack, name) } -> pack = mt.pack && name = mt.name
+						| _ -> false
+					end
+					|| begin
+						let path = (mt.pack,mt.name) in
+						let rec loop c =
+							if c.cl_path = path then true
+							else match c.cl_super with
+								| Some(c,_) -> loop c
+								| None -> false
+						in
+						loop ctx.c.curclass
+					end
+			| No -> false
+			| Maybe ->
+				begin try
+					let mt = ctx.g.do_load_type_def ctx null_pos {tpackage=mt.pack;tname=mt.module_name;tsub=Some mt.name;tparams=[]} in
+					begin match resolve_typedef mt with
+					| TClassDecl c -> has_constructor c
+					| TAbstractDecl a -> (match Abstract.follow_with_forward_ctor ~build:true (TAbstract(a,extract_param_types a.a_params)) with
+						| TInst(c,_) -> has_constructor c
+						| TAbstract(a,_) -> a.a_constructor <> None
+						| _ -> false)
+					| _ -> false
+					end
+				with _ ->
+					false
+				end
+			end
+		| ITTypeParameter {cl_kind = KTypeParameter ttp} when get_constructible_constraint ctx (get_constraints ttp) null_pos <> None ->
+			true
+		| _ -> false
+	) r.fitems
+
 let handle_display ctx e_ast dk mode with_type =
 	let old = ctx.f.in_display,ctx.f.in_call_args in
 	ctx.f.in_display <- true;
@@ -582,56 +632,7 @@ let handle_display ctx e_ast dk mode with_type =
 		end else
 			raise_toplevel ctx dk with_type (s_type_path path,p)
 	| DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) when (match fst e_ast with ENew _ -> true | _ -> false) ->
-		let timer = Timer.timer ["display";"toplevel";"filter ctors"] in
-		let l = List.filter (fun item ->
-			let is_private_to_current_module mt =
-				(* Remove the _Module nonsense from the package *)
-				let pack = List.rev (List.tl (List.rev mt.pack)) in
-				(pack,mt.module_name) = ctx.m.curmod.m_path
-			in
-			match item.ci_kind with
-			| ITType({kind = (Class | Abstract | TypeAlias)} as mt,_) when not mt.is_private || is_private_to_current_module mt ->
-				begin match mt.has_constructor with
-				| Yes -> true
-				| YesButPrivate ->
-					if (Meta.has Meta.PrivateAccess ctx.f.meta) then true
-					else
-						begin
-							match ctx.c.curclass.cl_kind with
-							| KAbstractImpl { a_path = (pack, name) } -> pack = mt.pack && name = mt.name
-							| _ -> false
-						end
-						|| begin
-							let path = (mt.pack,mt.name) in
-							let rec loop c =
-								if c.cl_path = path then true
-								else match c.cl_super with
-									| Some(c,_) -> loop c
-									| None -> false
-							in
-							loop ctx.c.curclass
-						end
-				| No -> false
-				| Maybe ->
-					begin try
-						let mt = ctx.g.do_load_type_def ctx null_pos {tpackage=mt.pack;tname=mt.module_name;tsub=Some mt.name;tparams=[]} in
-						begin match resolve_typedef mt with
-						| TClassDecl c -> has_constructor c
-						| TAbstractDecl a -> (match Abstract.follow_with_forward_ctor ~build:true (TAbstract(a,extract_param_types a.a_params)) with
-							| TInst(c,_) -> has_constructor c
-							| TAbstract(a,_) -> a.a_constructor <> None
-							| _ -> false)
-						| _ -> false
-						end
-					with _ ->
-						false
-					end
-				end
-			| ITTypeParameter {cl_kind = KTypeParameter ttp} when get_constructible_constraint ctx (get_constraints ttp) null_pos <> None ->
-				true
-			| _ -> false
-		) r.fitems in
-		timer();
+		let l = Timer.time ctx.com.timer_ctx ["display";"toplevel";"filter ctors"] (filter_ctors ctx) r in
 		raise_fields l CRNew r.fsubject
 	in
 	let e = match e_ast, e.eexpr with

std/haxe/Ucs2.hx

@@ -1,191 +0,0 @@
-/*
- * Copyright (C)2005-2019 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- */
-
-package haxe;
-
-/**
-	Cross platform UCS2 string API.
-**/
-abstract Ucs2(String) {
-	extern public var length(get, never):Int;
-
-	extern inline function new(str:String):Void {
-		// this implementation only allows platforms which have native UCS2 String.
-		// other platforms should create a shadow class in their _std directory
-		#if !(flash || js)
-		throw "Ucs2 String not supported on this platform";
-		#end
-		this = str;
-	}
-
-	extern inline function get_length() {
-		return this.length;
-	}
-
-	/**
-		Returns a Ucs2 where all characters of `this` Ucs2 are upper case.
-
-		Affects the characters `a-z`. Other characters remain unchanged.
-	**/
-	extern public inline function toUpperCase():Ucs2 {
-		return new Ucs2(this.toUpperCase());
-	}
-
-	/**
-		Returns a Ucs2 where all characters of `this` Ucs2 are lower case.
-
-		Affects the characters `A-Z`. Other characters remain unchanged.
-	**/
-	extern public inline function toLowerCase():Ucs2 {
-		return new Ucs2(this.toLowerCase());
-	}
-
-	/**
-		Returns the character at position `index` of `this` Ucs2.
-
-		If `index` is negative or exceeds `this.length`, the empty Ucs2 ""
-		is returned.
-	**/
-	extern public inline function charAt(index:Int):Ucs2 {
-		return new Ucs2(this.charAt(index));
-	}
-
-	/**
-		Returns the character code at position `index` of `this` Ucs2.
-
-		If `index` is negative or exceeds `this.length`, `null` is returned.
-
-		To obtain the character code of a single character, `"x".code` can be used
-		instead to extern public inline the character code at compile time. Note that this
-		only works on Ucs2 literals of length 1.
-	**/
-	extern public inline function charCodeAt(index:Int):Null<Int> {
-		return this.charCodeAt(index);
-	}
-
-	/**
-		Returns the position of the leftmost occurrence of `str` within `this`
-		Ucs2.
-
-		If `startIndex` is given, the search is performed within the substring
-		of `this` Ucs2 starting from `startIndex`. Otherwise the search is
-		performed within `this` Ucs2. In either case, the returned position
-		is relative to the beginning of `this` Ucs2.
-
-		If `str` cannot be found, -1 is returned.
-	**/
-	extern public inline function indexOf(str:Ucs2, ?startIndex:Int):Int {
-		return this.indexOf(str.toNativeString(), startIndex);
-	}
-
-	/**
-		Returns the position of the rightmost occurrence of `str` within `this`
-		Ucs2.
-
-		If `startIndex` is given, the search is performed within the substring
-		of `this` Ucs2 from 0 to `startIndex`. Otherwise the search is
-		performed within `this` Ucs2. In either case, the returned position
-		is relative to the beginning of `this` Ucs2.
-
-		If `str` cannot be found, -1 is returned.
-	**/
-	extern public inline function lastIndexOf(str:Ucs2, ?startIndex:Int):Int {
-		return this.lastIndexOf(str.toNativeString(), startIndex);
-	}
-
-	/**
-		Splits `this` Ucs2 at each occurrence of `delimiter`.
-
-		If `this` Ucs2 is the empty Ucs2 "", the result is not consistent
-		across targets and may either be `[]` (on Js, Cpp) or `[""]`.
-
-		If `delimiter` is the empty Ucs2 "", `this` Ucs2 is split into an
-		Array of `this.length` elements, where the elements correspond to the
-		characters of `this` Ucs2.
-
-		If `delimiter` is not found within `this` Ucs2, the result is an Array
-		with one element, which equals `this` Ucs2.
-
-		If `delimiter` is null, the result is unspecified.
-
-		Otherwise, `this` Ucs2 is split into parts at each occurrence of
-		`delimiter`. If `this` Ucs2 starts (or ends) with `delimiter`, the
-		result Array contains a leading (or trailing) empty Ucs2 "" element.
-		Two subsequent delimiters also result in an empty Ucs2 "" element.
-	**/
-	extern public inline function split(delimiter:Ucs2):Array<Ucs2> {
-		return cast this.split(delimiter.toNativeString());
-	}
-
-	/**
-		Returns `len` characters of `this` Ucs2, starting at position `pos`.
-
-		If `len` is omitted, all characters from position `pos` to the end of
-		`this` Ucs2 are included.
-
-		If `pos` is negative, its value is calculated from the end of `this`
-		Ucs2 by `this.length + pos`. If this yields a negative value, 0 is
-		used instead.
-
-		If the calculated position + `len` exceeds `this.length`, the characters
-		from that position to the end of `this` Ucs2 are returned.
-
-		If `len` is negative, the result is unspecified.
-	**/
-	extern public inline function substr(pos:Int, ?len:Int):Ucs2 {
-		return new Ucs2(this.substr(pos, len));
-	}
-
-	/**
-		Returns the part of `this` Ucs2 from `startIndex` to `endIndex`.
-
-		If `startIndex` or `endIndex` are negative, 0 is used instead.
-
-		If `startIndex` exceeds `endIndex`, they are swapped.
-
-		If the (possibly swapped) `endIndex` is omitted or exceeds
-		`this.length`, `this.length` is used instead.
-
-		If the (possibly swapped) `startIndex` exceeds `this.length`, the empty
-		Ucs2 "" is returned.
-	**/
-	extern public inline function substring(startIndex:Int, ?endIndex:Int):Ucs2 {
-		return new Ucs2(this.substring(startIndex, endIndex));
-	}
-
-	/**
-		Returns the native underlying String.
-	**/
-	extern public inline function toNativeString():String {
-		return this;
-	}
-
-	/**
-		Returns the Ucs2 corresponding to the character code `code`.
-
-		If `code` is negative or has another invalid value, the result is
-		unspecified.
-	**/
-	extern public static inline function fromCharCode(code:Int):Ucs2 {
-		return new Ucs2(String.fromCharCode(code));
-	}
-}

tests/unit/compile-each.hxml

@@ -11,4 +11,6 @@
 -D analyzer-optimize
 -D analyzer-user-var-fusion
 -D message.reporting=pretty
--D haxe-next
+-D haxe-next
+--times
+-D filter-times

tests/unit/src/unit/issues/Issue4940.hx

@@ -1,12 +1,12 @@
 package unit.issues;
 
 private enum Kind {
-    KA;
-    KB;
+	KA;
+	KB;
 }
 
 private class Base {
-    public function new() {}
+	public function new() {}
 }
 
 private class A extends Base {}
@@ -19,11 +19,11 @@ private enum abstract K(Int) {
 
 class Issue4940 extends Test {
 	function test() {
-        var kind = KA;
-        var base = switch (kind) {
-            case KA: new A();
-            case KB: new B();
-        }
+		var kind = KA;
+		var base = switch (kind) {
+			case KA: new A();
+			case KB: new B();
+		}
 		unit.HelperMacros.typedAs(new Base(), base);
 	}
 
@@ -35,4 +35,4 @@ class Issue4940 extends Test {
 		}
 		eq(2, x);
 	}
-}
+}