Преглед изворни кода

[hxb] only load up to EOF if at least one field is accessed (or full typing)

Rudy Ges пре 6 месеци
родитељ
комит
b9e0b68eba
2 измењених фајлова са 23 додато и 4 уклоњено
  1. 21 2
      src/compiler/hxb/hxbReader.ml
  2. 2 2
      src/compiler/server.ml

+ 21 - 2
src/compiler/hxb/hxbReader.ml

@@ -154,6 +154,7 @@ class hxb_reader
 	val mutable api = Obj.magic ""
 	val mutable api = Obj.magic ""
 	val mutable full_restore = true
 	val mutable full_restore = true
 	val mutable current_module = null_module
 	val mutable current_module = null_module
+	val mutable delayed_field_loading : (unit->unit) list = []
 
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
 	val mutable has_string_pool = (string_pool <> None)
 	val mutable has_string_pool = (string_pool <> None)
@@ -177,6 +178,9 @@ class hxb_reader
 	val mutable field_type_parameter_offset = 0
 	val mutable field_type_parameter_offset = 0
 	val empty_anon = mk_anon (ref Closed)
 	val empty_anon = mk_anon (ref Closed)
 
 
+	method set_delayed_field_loading f =
+		delayed_field_loading <- f :: delayed_field_loading
+
 	method resolve_type pack mname tname =
 	method resolve_type pack mname tname =
 		try
 		try
 			let mt = api#resolve_type pack mname tname in
 			let mt = api#resolve_type pack mname tname in
@@ -1933,7 +1937,22 @@ class hxb_reader
 				c.cl_flags <- read_uleb128 ch;
 				c.cl_flags <- read_uleb128 ch;
 
 
 				let read_field () =
 				let read_field () =
-					self#read_class_field_forward;
+					let cf = self#read_class_field_forward in
+					if not full_restore then begin
+						let r = ref (lazy_processing t_dynamic) in
+						r := lazy_wait (fun() ->
+							let rec loop = function
+								| [] -> []
+								| f :: l ->
+									f();
+									loop l
+							in
+							delayed_field_loading <- loop delayed_field_loading;
+							cf.cf_type
+						);
+						cf.cf_type <- TLazy r;
+					end;
+					cf
 				in
 				in
 
 
 				c.cl_constructor <- self#read_option read_field;
 				c.cl_constructor <- self#read_option read_field;
@@ -1943,7 +1962,7 @@ class hxb_reader
 						if i = 0 then
 						if i = 0 then
 							acc_l,acc_pm
 							acc_l,acc_pm
 						else begin
 						else begin
-							let cf = self#read_class_field_forward in
+							let cf = read_field () in
 							loop (cf :: acc_l) (PMap.add cf.cf_name cf acc_pm) (i - 1)
 							loop (cf :: acc_l) (PMap.add cf.cf_name cf acc_pm) (i - 1)
 						end
 						end
 					in
 					in

+ 2 - 2
src/compiler/server.ml

@@ -453,7 +453,7 @@ class hxb_reader_api_server
 			(* We try to avoid reading expressions as much as possible, so we only do this for
 			(* We try to avoid reading expressions as much as possible, so we only do this for
 				 our current display file if we're in display mode. *)
 				 our current display file if we're in display mode. *)
 			if full_restore then ignore(f_next chunks EOM)
 			if full_restore then ignore(f_next chunks EOM)
-			else delay PConnectField (fun () -> ignore(f_next chunks EOF));
+			else reader#set_delayed_field_loading (fun () -> ignore(f_next chunks EOF));
 			m
 			m
 		| BadModule reason ->
 		| BadModule reason ->
 			die (Printf.sprintf "Unexpected BadModule %s (%s)" (s_type_path path) (Printer.s_module_skip_reason reason)) __LOC__
 			die (Printf.sprintf "Unexpected BadModule %s (%s)" (s_type_path path) (Printer.s_module_skip_reason reason)) __LOC__
@@ -605,7 +605,7 @@ and type_module sctx com delay mpath p =
 					(* We try to avoid reading expressions as much as possible, so we only do this for
 					(* We try to avoid reading expressions as much as possible, so we only do this for
 					   our current display file if we're in display mode. *)
 					   our current display file if we're in display mode. *)
 					if full_restore then ignore(f_next chunks EOM)
 					if full_restore then ignore(f_next chunks EOM)
-					else delay PConnectField (fun () -> ignore(f_next chunks EOF));
+					else reader#set_delayed_field_loading (fun () -> ignore(f_next chunks EOF));
 					add_modules true m;
 					add_modules true m;
 				| Some reason ->
 				| Some reason ->
 					skip mpath reason
 					skip mpath reason