Selaa lähdekoodia

forward declare module type parameters in MTF

We need to know their identity early so the instance builder can work. Constraints and defaults are set later.
Simon Krajewski 1 vuosi sitten
vanhempi
commit
9c3b3e54a2
2 muutettua tiedostoa jossa 39 lisäystä ja 24 poistoa
  1. 26 17
      src/compiler/hxb/hxbReader.ml
  2. 13 7
      src/compiler/hxb/hxbWriter.ml

+ 26 - 17
src/compiler/hxb/hxbReader.ml

@@ -802,11 +802,9 @@ class hxb_reader
 	method read_types =
 		self#read_list (fun () -> self#read_type_instance)
 
-	(* Fields *)
-
-	method read_type_parameters (f : typed_type_param array -> unit) =
-		let l = read_uleb128 ch in
-		let a = Array.init l (fun _ ->
+	method read_type_parameters_forward =
+		let length = read_uleb128 ch in
+		Array.init length (fun _ ->
 			let path = self#read_path in
 			let pos = self#read_pos in
 			let host = match IO.read_byte ch with
@@ -819,22 +817,28 @@ class hxb_reader
 				| i -> die (Printf.sprintf "Invalid type paramter host: %i" i) __LOC__
 			in
 			let c = mk_class current_module path pos pos in
-			mk_type_param c host None None
-		) in
-		f a;
-		for i = 0 to l - 1 do
+			let ttp = mk_type_param c host None None in
+			c.cl_kind <- KTypeParameter ttp;
+			ttp
+		)
+
+	method read_type_parameters_data (a : typed_type_param array) =
+		Array.iter (fun ttp ->
 			let meta = self#read_metadata in
 			let constraints = self#read_types in
 			let def = self#read_option (fun () -> self#read_type_instance) in
-
-			let ttp = a.(i) in
 			let c = ttp.ttp_class in
-			let ttp = a.(i) in
 			ttp.ttp_default <- def;
 			ttp.ttp_constraints <- Some (Lazy.from_val constraints);
 			c.cl_meta <- meta;
-			c.cl_kind <- KTypeParameter ttp
-		done;
+		) a
+
+	method read_type_parameters (f : typed_type_param array -> unit) =
+		let a = self#read_type_parameters_forward in
+		f a;
+		self#read_type_parameters_data a
+
+	(* Fields *)
 
 	method read_field_kind = match IO.read_byte ch with
 		| 0 -> Method MethNormal
@@ -1369,7 +1373,9 @@ class hxb_reader
 		infos.mt_private <- self#read_bool;
 		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
 		infos.mt_meta <- self#read_metadata;
-		self#read_type_parameters (fun a -> type_type_parameters <- a);
+		let params = Array.of_list infos.mt_params in
+		type_type_parameters <- params;
+		self#read_type_parameters_data params;
 		infos.mt_params <- Array.to_list type_type_parameters;
 		infos.mt_using <- self#read_list (fun () ->
 			let c = self#read_class_ref in
@@ -1702,10 +1708,11 @@ class hxb_reader
 			let path = self#read_path in
 			let pos = self#read_pos in
 			let name_pos = self#read_pos in
+			let params = self#read_type_parameters_forward in
 			let mt = match kind with
 			| 0 ->
 				let c = mk_class current_module path pos name_pos in
-				classes <- Array.append classes (Array.make 1 c);
+				c.cl_params <- Array.to_list params;
 
 				let read_field () =
 					self#read_class_field_forward;
@@ -1720,7 +1727,7 @@ class hxb_reader
 				TClassDecl c
 			| 1 ->
 				let en = mk_enum current_module path pos name_pos in
-				enums <- Array.append enums (Array.make 1 en);
+				en.e_params <- Array.to_list params;
 
 				let read_field () =
 					let name = self#read_string in
@@ -1740,10 +1747,12 @@ class hxb_reader
 				TEnumDecl en
 			| 2 ->
 				let td = mk_typedef current_module path pos name_pos (mk_mono()) in
+				td.t_params <- Array.to_list params;
 				typedefs <- Array.append typedefs (Array.make 1 td);
 				TTypeDecl td
 			| 3 ->
 				let a = mk_abstract current_module path pos name_pos in
+				a.a_params <- Array.to_list params;
 				abstracts <- Array.append abstracts (Array.make 1 a);
 				TAbstractDecl a
 			| _ ->

+ 13 - 7
src/compiler/hxb/hxbWriter.ml

@@ -1615,10 +1615,7 @@ class hxb_writer
 		in
 		loop e
 
-	(* Fields *)
-
-	method write_type_parameters (ttps : typed_type_param list) =
-		IOChunk.write_uleb128 chunk.io (List.length ttps);
+	method write_type_parameters_forward (ttps : typed_type_param list) =
 		let write_type_parameter_forward ttp =
 			self#write_path ttp.ttp_class.cl_path;
 			self#write_pos ttp.ttp_class.cl_name_pos;
@@ -1632,14 +1629,22 @@ class hxb_writer
 			in
 			IOChunk.write_u8 chunk.io i
 		in
+		Chunk.write_list chunk ttps write_type_parameter_forward
+
+	method write_type_parameters_data (ttps : typed_type_param list) =
 		let write_type_parameter_data ttp =
 			let c = ttp.ttp_class in
 			self#write_metadata c.cl_meta;
 			self#write_types (get_constraints ttp);
 			Chunk.write_option chunk ttp.ttp_default self#write_type_instance
 		in
-		List.iter write_type_parameter_forward ttps;
-		List.iter write_type_parameter_data ttps;
+		List.iter write_type_parameter_data ttps
+
+	method write_type_parameters (ttps : typed_type_param list) =
+		self#write_type_parameters_forward ttps;
+		self#write_type_parameters_data ttps;
+
+	(* Fields *)
 
 	method write_field_kind = function
 		| Method MethNormal -> IOChunk.write_u8 chunk.io 0;
@@ -1803,7 +1808,7 @@ class hxb_writer
 		IOChunk.write_bool chunk.io infos.mt_private;
 		Chunk.write_option chunk infos.mt_doc self#write_documentation;
 		self#write_metadata infos.mt_meta;
-		self#write_type_parameters infos.mt_params;
+		self#write_type_parameters_data infos.mt_params;
 		Chunk.write_list chunk infos.mt_using (fun (c,p) ->
 			self#write_class_ref c;
 			self#write_pos p;
@@ -1973,6 +1978,7 @@ class hxb_writer
 		self#write_path (fst infos.mt_path, !name);
 		self#write_pos infos.mt_pos;
 		self#write_pos infos.mt_name_pos;
+		self#write_type_parameters_forward infos.mt_params;
 		let params = new pool in
 		type_type_parameters <- params;
 		ignore(type_param_lut#add infos.mt_path params);