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

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 година
родитељ
комит
9c3b3e54a2
2 измењених фајлова са 39 додато и 24 уклоњено
  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);