basic reader stats

src/compiler/hxb/hxbAbstractReader.ml

@@ -4,8 +4,8 @@ open HxbReader
 class virtual hxb_abstract_reader = object(self)
 	inherit hxb_reader_api
 
-	method read_hxb (input : IO.input) =
-		let reader = new HxbReader.hxb_reader in
+	method read_hxb (input : IO.input) (stats : HxbReader.hxb_reader_stats) =
+		let reader = new HxbReader.hxb_reader stats in
 		let result = reader#read (self :> hxb_reader_api) HHDR input in
 		let rec loop result = match result with
 			| FullModule m ->

src/compiler/hxb/hxbReader.ml

@@ -41,8 +41,23 @@ type hxb_reader_result =
 
 and hxb_continuation = hxb_reader_api -> chunk_kind -> hxb_reader_result
 
-class hxb_reader
+type hxb_reader_stats = {
+	modules_fully_restored : int ref;
+	modules_partially_restored : int ref;
+}
+
+let create_hxb_reader_stats () = {
+	modules_fully_restored = ref 0;
+	modules_partially_restored = ref 0;
+}
+
+let dump_stats name stats =
+	print_endline (Printf.sprintf "hxb_reader stats for %s" name);
+	print_endline (Printf.sprintf "  modules partially restored: %i" (!(stats.modules_fully_restored) - !(stats.modules_partially_restored)));
+	print_endline (Printf.sprintf "  modules fully restored: %i" !(stats.modules_fully_restored));
 
+class hxb_reader
+	(stats : hxb_reader_stats)
 = object(self)
 	val mutable api = Obj.magic ""
 	val mutable current_module = null_module
@@ -1618,6 +1633,7 @@ class hxb_reader
 			ch <- IO.input_bytes data;
 			match chunk with
 			| HEND ->
+				incr stats.modules_fully_restored;
 				FullModule current_module
 			| STRI ->
 				string_pool <- self#read_string_pool;
@@ -1626,6 +1642,7 @@ class hxb_reader
 				doc_pool <- self#read_string_pool;
 				loop()
 			| HHDR ->
+				incr stats.modules_partially_restored;
 				current_module <- self#read_hhdr;
 				if stop = HHDR then
 					HeaderOnly(current_module,self#continue file_ch)

src/compiler/server.ml

@@ -412,7 +412,7 @@ class hxb_reader_api_server
 			| GoodModule m ->
 				m
 			| BinaryModule mc ->
-				self#read_hxb (IO.input_bytes mc.mc_bytes)
+				self#read_hxb (IO.input_bytes mc.mc_bytes) ctx.com.hxb_reader_stats
 			| BadModule reason ->
 				die (Printf.sprintf "Unexpected BadModule %s" (s_type_path path)) __LOC__
 			| NoModule ->
@@ -481,7 +481,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_hxb (IO.input_bytes mc.mc_bytes);
+								(new hxb_reader_api_server ctx cc)#read_hxb (IO.input_bytes mc.mc_bytes) 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 ->
@@ -549,7 +549,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 m = (new hxb_reader_api_server ctx cc)#read_hxb (IO.input_bytes mc.mc_bytes) in
+					let m = (new hxb_reader_api_server ctx cc)#read_hxb (IO.input_bytes mc.mc_bytes) com.hxb_reader_stats in
 					add_modules true m;
 				| Some reason ->
 					skip mpath reason

src/context/common.ml

@@ -411,6 +411,7 @@ type context = {
 	(* misc *)
 	mutable basic : basic_types;
 	memory_marker : float array;
+	hxb_reader_stats : HxbReader.hxb_reader_stats;
 	hxb_writer_stats : HxbWriter.hxb_writer_stats;
 }
 
@@ -872,6 +873,7 @@ let create compilation_step cs version args display_mode =
 		has_error = false;
 		report_mode = RMNone;
 		is_macro_context = false;
+		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_stats = HxbWriter.create_hxb_writer_stats ();
 	} in
 	com
@@ -918,6 +920,7 @@ let clone com is_macro_context =
 		module_to_file = new hashtbl_lookup;
 		overload_cache = new hashtbl_lookup;
 		module_lut = new module_lut;
+		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_stats = HxbWriter.create_hxb_writer_stats ();
 }
 

src/context/commonCache.ml

@@ -87,8 +87,10 @@ let rec cache_context cs com =
 		| None -> ()
 		| Some com -> cache_context cs com
 	end;
-	if Define.raw_defined com.defines "hxb.stats" then
+	if Define.raw_defined com.defines "hxb.stats" then begin
+		HxbReader.dump_stats (platform_name com.platform) com.hxb_reader_stats;
 		HxbWriter.dump_stats (platform_name com.platform) com.hxb_writer_stats
+	end
 
 let maybe_add_context_sign cs com desc =
 	let sign = Define.get_signature com.defines in

src/context/display/displayJson.ml

@@ -135,7 +135,7 @@ class hxb_reader_api_com
 			cc#find_module m_path
 		with Not_found ->
 			let mc = cc#get_hxb_module m_path in
-			self#read_hxb (IO.input_bytes mc.mc_bytes)
+			self#read_hxb (IO.input_bytes mc.mc_bytes) com.hxb_reader_stats
 
 	method basic_types =
 		com.basic

src/context/display/displayTexpr.ml

@@ -173,7 +173,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_hxb (IO.input_bytes mc.mc_bytes) in
+				let m = (TypeloadModule.get_reader ctx p)#read_hxb (IO.input_bytes mc.mc_bytes) ctx.com.hxb_reader_stats in
 				check_display_module ctx cfile.c_decls m
 			| GoodModule m ->
 				check_display_module ctx cfile.c_decls m

src/typing/typeloadModule.ml

@@ -822,7 +822,7 @@ and load_hxb_module ctx path p =
 	(* TODO use finally instead *)
 	try
 		(* Printf.eprintf "[%s] Read module %s\n" target (s_type_path path); *)
-		let m = (get_reader ctx p)#read_hxb input in
+		let m = (get_reader ctx p)#read_hxb input ctx.com.hxb_reader_stats in
 		(* Printf.eprintf "[%s] Done reading module %s\n" target (s_type_path path); *)
 		close_in ch;
 		m