less nightmares

src/compiler/hxb/hxbAbstractReader.ml

@@ -4,14 +4,14 @@ open HxbData
 class virtual hxb_abstract_reader = object(self)
 	inherit hxb_reader_api
 
-	method read_hxb (bytes : bytes) (stats : HxbReader.hxb_reader_stats) =
-		let reader = new HxbReader.hxb_reader stats in
+	method read_hxb (path : Globals.path) (bytes : bytes) (stats : HxbReader.hxb_reader_stats) =
+		let reader = new HxbReader.hxb_reader path stats in
 		reader#read (self :> hxb_reader_api) bytes
 
-	method read_chunks (chunks : cached_chunks) (stats : HxbReader.hxb_reader_stats) =
-		fst (self#read_chunks_until chunks stats EOM)
+	method read_chunks (path : Globals.path) (chunks : cached_chunks) (stats : HxbReader.hxb_reader_stats) =
+		fst (self#read_chunks_until path chunks stats EOM)
 
-	method read_chunks_until (chunks : cached_chunks) (stats : HxbReader.hxb_reader_stats) (until : HxbData.chunk_kind) =
-		let reader = new HxbReader.hxb_reader stats in
+	method read_chunks_until (path : Globals.path) (chunks : cached_chunks) (stats : HxbReader.hxb_reader_stats) (until : HxbData.chunk_kind) =
+		let reader = new HxbReader.hxb_reader path stats in
 		reader#read_chunks_until (self :> hxb_reader_api) chunks until
 end

src/compiler/hxb/hxbReader.ml

@@ -112,11 +112,11 @@ let dump_stats name stats =
 	print_endline (Printf.sprintf "  modules fully restored: %i" !(stats.modules_fully_restored));
 
 class hxb_reader
+	(mpath : path)
 	(stats : hxb_reader_stats)
 = object(self)
 	val mutable api = Obj.magic ""
 	val mutable current_module = null_module
-	val mutable timers = Array.make 3 (EOM,None)
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
 	val mutable string_pool = Array.make 0 ""
@@ -1841,17 +1841,6 @@ class hxb_reader
 			doc_pool <- self#read_string_pool;
 		| MDF ->
 			current_module <- self#read_mdf;
-
-			let module_name = String.concat "_" (ExtLib.String.nsplit (s_type_path current_module.m_path) ".") in
-			Array.iter (fun (kind, timer) ->
-				match timer with
-					| None -> ()
-					| Some (t:Timer.timer_infos) ->
-						let infos = match kind with STR -> Printf.sprintf "%d strings." (Array.length string_pool) | _ -> "" in
-						Hashtbl.remove Timer.htimers t.id;
-						t.id <- t.id @ [infos ^ module_name];
-						Hashtbl.add Timer.htimers t.id t;
-			) timers;
 		| MTF ->
 			current_module.m_types <- self#read_mtf;
 			api#add_module current_module;
@@ -1893,18 +1882,9 @@ class hxb_reader
 			incr stats.modules_fully_restored;
 
 	method private read_chunk_data kind =
-		let id = ["hxb";"read";string_of_chunk_kind kind] in
-		let id = match kind with
-			| STR | DOC | MDF -> id
-			| _ -> id @ [String.concat "_" (ExtLib.String.nsplit (s_type_path current_module.m_path) ".")]
-		in
-
-		let close,t = Timer.timer_with_ref id in
-		(match kind with
-			| STR -> timers.(0) <- (kind, t)
-			| DOC -> timers.(1) <- (kind, t)
-			| MDF -> timers.(2) <- (kind, t)
-			| _ -> ());
+		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 = Timer.timer id in
 		self#read_chunk_data' kind;
 		close()
 

src/compiler/server.ml

@@ -417,7 +417,7 @@ class hxb_reader_api_server
 			| GoodModule m ->
 				m
 			| BinaryModule mc ->
-				self#read_chunks mc.mc_chunks ctx.com.hxb_reader_stats
+				self#read_chunks mc.mc_path mc.mc_chunks ctx.com.hxb_reader_stats
 			| BadModule reason ->
 				die (Printf.sprintf "Unexpected BadModule %s" (s_type_path path)) __LOC__
 			| NoModule ->
@@ -489,7 +489,7 @@ let rec add_modules sctx ctx (m : module_def) (from_binary : bool) (p : pos) =
 							| GoodModule m ->
 								m
 							| BinaryModule mc ->
-								(new hxb_reader_api_server ctx cc)#read_chunks mc.mc_chunks ctx.com.hxb_reader_stats
+								(new hxb_reader_api_server ctx cc)#read_chunks mc.mc_path mc.mc_chunks ctx.com.hxb_reader_stats
 							| NoModule ->
 								failwith (Printf.sprintf "Unexpectedly could not find module %s as a dependency of %s" (s_type_path mpath) (s_type_path m0.m_path))
 							| BadModule reason ->
@@ -557,7 +557,7 @@ and type_module sctx (ctx:Typecore.typer) mpath p =
 			   checking dependencies. This means that the actual decoding never has any reason to fail. *)
 			begin match check_module sctx ctx mpath mc.mc_extra p with
 				| None ->
-					let reader = new HxbReader.hxb_reader com.hxb_reader_stats in
+					let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats in
 					let api = (new hxb_reader_api_server ctx cc :> HxbReaderApi.hxb_reader_api) in
 					let f_next chunks until =
 						let t_hxb = Timer.timer ["server";"module cache";"hxb read"] in

src/context/display/displayJson.ml

@@ -137,7 +137,7 @@ class hxb_reader_api_com
 			cc#find_module m_path
 		with Not_found ->
 			let mc = cc#get_hxb_module m_path in
-			fst (self#read_chunks_until mc.mc_chunks com.hxb_reader_stats (if headers_only then EOM else MTF))
+			fst (self#read_chunks_until mc.mc_path mc.mc_chunks com.hxb_reader_stats (if headers_only then EOM else MTF))
 
 	method basic_types =
 		com.basic

src/context/display/displayTexpr.ml

@@ -176,7 +176,7 @@ let check_display_file ctx cs =
 				begin match !TypeloadModule.type_module_hook ctx path null_pos with
 				| NoModule | BadModule _ -> raise Not_found
 				| BinaryModule mc ->
-					let m = (TypeloadModule.get_reader ctx p)#read_chunks mc.mc_chunks ctx.com.hxb_reader_stats in
+					let m = (TypeloadModule.get_reader ctx p)#read_chunks mc.mc_path mc.mc_chunks ctx.com.hxb_reader_stats in
 					m
 				| GoodModule m ->
 					m

src/core/timer.ml

@@ -18,7 +18,7 @@
  *)
 
 type timer_infos = {
-	mutable id : string list;
+	id : string list;
 	mutable start : float list;
 	mutable pauses : float list;
 	mutable total : float;
@@ -77,14 +77,6 @@ let timer id =
 	) else
 		(fun() -> ())
 
-let timer_with_ref id =
-	if !measure_times then (
-		let t = new_timer id in
-		curtime := t :: !curtime;
-		((function() -> close (get_time()) t), Some t)
-	) else
-		((fun() -> ()), None)
-
 let current_id() =
 	match !curtime with
 	| [] -> None
@@ -220,4 +212,4 @@ class timer (id : string list) = object(self)
 
 	method nest (name : string) =
 		new timer (id @ [name])
-end
+end

src/typing/typeloadModule.ml

@@ -809,7 +809,7 @@ let rec get_reader ctx p =
 and load_hxb_module ctx path p =
 	let read file bytes =
 		try
-			let read = (get_reader ctx p)#read_hxb bytes ctx.com.hxb_reader_stats in
+			let read = (get_reader ctx p)#read_hxb path bytes ctx.com.hxb_reader_stats in
 			let m = read MTF in
 			delay ctx PBuildClass (fun () ->
 				ignore(read EOT);