Explorar o código

[hxb] handle more type parameter cases

Note: still fails with some @:generic cases for example
Rudy Ges %!s(int64=2) %!d(string=hai) anos
pai
achega
2214a70ee7
Modificáronse 2 ficheiros con 23 adicións e 38 borrados
  1. 6 26
      src/compiler/hxb/hxbReader.ml
  2. 17 12
      src/compiler/hxb/hxbWriter.ml

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

@@ -1011,9 +1011,7 @@ class hxb_reader
 	method read_class_field (m : module_def) (cf : tclass_field) : unit =
 		let name = cf.cf_name in
 		(* Printf.eprintf "  Read class field %s\n" name; *)
-		self#read_type_parameters m ([],name) (fun a ->
-			field_type_parameters <- a
-		);
+		self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
 		let params = Array.to_list field_type_parameters in
 		let t = self#read_type_instance in
 
@@ -1041,9 +1039,7 @@ class hxb_reader
 	method read_class_field' (m : module_def) : tclass_field =
 		let name = self#read_string in
 		(* Printf.eprintf "  Read class field %s\n" name; *)
-		self#read_type_parameters m ([],name) (fun a ->
-			field_type_parameters <- a
-		);
+		self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
 		let params = Array.to_list field_type_parameters in
 		let t = self#read_type_instance in
 		let flags = IO.read_i32 ch in
@@ -1169,9 +1165,7 @@ class hxb_reader
 		a.a_from <- self#read_list (fun () -> self#read_type_instance);
 		a.a_from_field <- self#read_list (fun () ->
 			let name = self#read_string in
-			self#read_type_parameters m ([],name) (fun a ->
-				field_type_parameters <- a
-			);
+			self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
 			let t = self#read_type_instance in
 			let impl = Option.get a.a_impl in
 			(* Printf.eprintf "  Read field ref for abstract from field %s (a = %s)\n" name (s_type_path a.a_path); *)
@@ -1182,9 +1176,7 @@ class hxb_reader
 		a.a_to <- self#read_list (fun () -> self#read_type_instance);
 		a.a_to_field <- self#read_list (fun () ->
 			let name = self#read_string in
-			self#read_type_parameters m ([],name) (fun a ->
-				field_type_parameters <- a
-			);
+			self#read_type_parameters m ([],name) (fun a -> field_type_parameters <- a);
 			let t = self#read_type_instance in
 			let impl = Option.get a.a_impl in
 			(* Printf.eprintf "  Read field ref for abstract to field %s (a = %s)\n" name (s_type_path a.a_path); *)
@@ -1269,20 +1261,7 @@ class hxb_reader
 	method read_annd (m : module_def) =
 		let l = self#read_uleb128 in
 		for i = 0 to l - 1 do
-			let tname = self#read_option (fun () -> self#read_string) in
-			match tname with
-			| None -> ()
-			| Some tname ->
-				(match List.find_opt (fun t -> snd (t_path t) = tname) m.m_types with
-				| None -> ()
-				| Some parent ->
-					begin match parent with
-					| TClassDecl c -> type_type_parameters <- Array.of_list c.cl_params;
-					| TEnumDecl en -> type_type_parameters <- Array.of_list en.e_params;
-					| TTypeDecl td -> type_type_parameters <- Array.of_list td.t_params;
-					| TAbstractDecl a -> type_type_parameters <- Array.of_list a.a_params;
-					end
-				);
+			self#read_type_parameters m ([],"") (fun a -> type_type_parameters <- a);
 
 			let an = anons.(i) in
 			let read_fields () =
@@ -1316,6 +1295,7 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		for i = 0 to l - 1 do
 			let cf = anon_fields.(i) in
+			self#read_type_parameters m ([],"") (fun a -> type_type_parameters <- a);
 			let _ = self#read_string in
 			self#read_class_field m cf;
 		done

+ 17 - 12
src/compiler/hxb/hxbWriter.ml

@@ -294,7 +294,7 @@ class ['a] hxb_writer
 
 	method write_anon_ref (an : tanon) =
 		let pfm = Option.get (anon_id#identify true (TAnon an)) in
-		let i = anons#get_or_add pfm.pfm_path (an,ttp_key) in
+		let i = anons#get_or_add pfm.pfm_path (an,type_type_parameters,field_type_parameters) in
 		(* Printf.eprintf "  Write anon ref %d for %s\n" i (s_type_path pfm.pfm_path); *)
 		chunk#write_uleb128 i
 
@@ -928,7 +928,7 @@ class ['a] hxb_writer
 			| TField(e1,FAnon cf) ->
 				chunk#write_byte 104;
 				loop e1;
-				chunk#write_uleb128 (anon_fields#get_or_add cf cf);
+				chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
 			| TField(e1,FClosure(Some(c,tl),cf)) ->
 				chunk#write_byte 105;
 				loop e1;
@@ -938,7 +938,7 @@ class ['a] hxb_writer
 			| TField(e1,FClosure(None,cf)) ->
 				chunk#write_byte 106;
 				loop e1;
-				chunk#write_uleb128 (anon_fields#get_or_add cf cf);
+				chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
 			| TField(e1,FEnum(en,ef)) ->
 				chunk#write_byte 107;
 				loop e1;
@@ -1196,15 +1196,15 @@ class ['a] hxb_writer
 		self#write_common_module_type (Obj.magic td);
 		self#write_type_instance td.t_type;
 
-	method write_anon (m : module_def) ((an : tanon), (ttp_key : path option)) =
-		chunk#write_option ttp_key (fun (_,k) -> chunk#write_string k);
-		match ttp_key with
-		| None -> ()
-		| Some ttp_key -> self#select_type ttp_key;
+	method write_anon (m : module_def) ((an : tanon), (ttp : (string, typed_type_param) pool), (ftp : (string, typed_type_param) pool)) =
+		type_type_parameters <- ttp;
+		let ttp = ttp#to_list in
+		chunk#write_list ttp self#write_type_parameter_forward;
+		chunk#write_list ttp self#write_type_parameter_data;
 
 		let write_fields () =
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) an.a_fields []) (fun (_,cf) ->
-				self#write_class_field ~with_pos:true cf;
+				self#write_class_field ~with_pos:true { cf with cf_params = (cf.cf_params @ ftp#to_list) };
 			)
 		in
 
@@ -1391,15 +1391,20 @@ class ['a] hxb_writer
 			()
 		| l ->
 			self#start_chunk ANFR;
-			chunk#write_list l (fun cf ->
+			chunk#write_list l (fun (cf,_,_) ->
 				(* Printf.eprintf "Write anon field %s\n" cf.cf_name; *)
 				chunk#write_string cf.cf_name;
 				self#write_pos cf.cf_pos;
 				self#write_pos cf.cf_name_pos;
 			);
 			self#start_chunk ANFD;
-			chunk#write_list l (fun cf ->
-				self#write_class_field cf;
+			chunk#write_list l (fun (cf,ttp,ftp) ->
+				(* Printf.eprintf "Write anon field def %s\n" cf.cf_name; *)
+				type_type_parameters <- ttp;
+				let ttp = ttp#to_list in
+				chunk#write_list ttp self#write_type_parameter_forward;
+				chunk#write_list ttp self#write_type_parameter_data;
+				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp#to_list) };
 			);
 		end;