Bläddra i källkod

[hxb] adjust debug, work on unbound type params

Rudy Ges 2 år sedan
förälder
incheckning
153ffe4ca1

+ 5 - 3
src/compiler/generate.ml

@@ -21,11 +21,12 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 			Genjson.generate com.types file
 	end
 	end
 
 
-let export_hxb root m =
+let export_hxb com root m =
 	match m.m_extra.m_kind with
 	match m.m_extra.m_kind with
 		| MCode | MMacro | MFake -> begin
 		| MCode | MMacro | MFake -> begin
+			(* Printf.eprintf "Export module %s\n" (s_type_path m.m_path); *)
 			let anon_identification = new tanon_identification ([],"") in
 			let anon_identification = new tanon_identification ([],"") in
-			let writer = new HxbWriter.hxb_writer anon_identification in
+			let writer = new HxbWriter.hxb_writer com anon_identification in
 			writer#write_module m;
 			writer#write_module m;
 			let ch = IO.output_bytes() in
 			let ch = IO.output_bytes() in
 			let bytes_module = IO.close_out ch in
 			let bytes_module = IO.close_out ch in
@@ -73,7 +74,8 @@ let check_hxb_output com actx =
 				Path.mkdir_from_path path;
 				Path.mkdir_from_path path;
 				clean_files path;
 				clean_files path;
 				let t = Timer.timer ["generate";"hxb"] in
 				let t = Timer.timer ["generate";"hxb"] in
-				List.iter (export_hxb path) com.modules;
+				Printf.eprintf "%d modules, %d types\n" (List.length com.modules) (List.length com.types);
+				List.iter (export_hxb com path) com.modules;
 				t();
 				t();
 			in
 			in
 
 

+ 15 - 28
src/compiler/hxb/hxbReader.ml

@@ -9,7 +9,7 @@ let c_reset = if no_color then "" else "\x1b[0m"
 let c_bold = if no_color then "" else "\x1b[1m"
 let c_bold = if no_color then "" else "\x1b[1m"
 let c_dim = if no_color then "" else "\x1b[2m"
 let c_dim = if no_color then "" else "\x1b[2m"
 let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo = "\x1b[33m[TODO]" ^ c_reset
-let todo_error = "\x1b[41m[TODO] error:" ^ c_reset
+let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
 
 class hxb_reader
 class hxb_reader
 	(com : Common.context)
 	(com : Common.context)
@@ -185,7 +185,7 @@ class hxb_reader
 	method read_field_ref fields =
 	method read_field_ref fields =
 		let name = self#read_string in
 		let name = self#read_string in
 		try PMap.find name fields with e ->
 		try PMap.find name fields with e ->
-			Printf.eprintf "  %s reading field %s\n" todo_error name;
+			Printf.eprintf "[%s]  %s reading field %s\n" (s_type_path m.m_path) todo_error name;
 			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields "");
 			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields "");
 			null_field
 			null_field
 
 
@@ -676,7 +676,8 @@ class hxb_reader
 			TFun(args,ret)
 			TFun(args,ret)
 		| 33 ->
 		| 33 ->
 			let t = self#read_type_instance in
 			let t = self#read_type_instance in
-			TLazy (ref (LAvailable t))
+			(* TLazy (ref (LAvailable t)) *)
+			t
 		| 40 ->
 		| 40 ->
 			t_dynamic
 			t_dynamic
 		| 41 ->
 		| 41 ->
@@ -991,6 +992,9 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let e1 = self#read_texpr in
 				let en = self#read_enum_ref in
 				let en = self#read_enum_ref in
 				let ef = self#read_enum_field_ref en in
 				let ef = self#read_enum_field_ref en in
+				let params = ref [] in
+				self#read_type_parameters ([],ef.ef_name) (fun a -> params := Array.to_list a);
+				ef.ef_params <- !params;
 				TField(e1,FEnum(en,ef))
 				TField(e1,FEnum(en,ef))
 			| 108 ->
 			| 108 ->
 				let e1 = self#read_texpr in
 				let e1 = self#read_texpr in
@@ -1148,13 +1152,12 @@ class hxb_reader
 		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
 		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
 
 
 	method read_enum_fields (e : tenum) =
 	method read_enum_fields (e : tenum) =
+		type_type_parameters <- Array.of_list e.e_params;
 		ignore(self#read_list (fun () ->
 		ignore(self#read_list (fun () ->
 			let name = self#read_string in
 			let name = self#read_string in
 			(* Printf.eprintf "  Read enum field %s\n" name; *)
 			(* Printf.eprintf "  Read enum field %s\n" name; *)
 			let ef = PMap.find name e.e_constrs in
 			let ef = PMap.find name e.e_constrs in
-			self#read_type_parameters ([],name) (fun a ->
-				field_type_parameters <- a
-			);
+			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			ef.ef_params <- Array.to_list field_type_parameters;
 			ef.ef_params <- Array.to_list field_type_parameters;
 			ef.ef_type <- self#read_type_instance;
 			ef.ef_type <- self#read_type_instance;
 			ef.ef_doc <- self#read_option (fun () -> self#read_documentation);
 			ef.ef_doc <- self#read_option (fun () -> self#read_documentation);
@@ -1164,14 +1167,12 @@ class hxb_reader
 	(* Module types *)
 	(* Module types *)
 
 
 	method read_common_module_type (infos : tinfos) =
 	method read_common_module_type (infos : tinfos) =
+		(* if (snd m.m_path) = "Issue9149" then *)
+		(* Printf.eprintf "[%s] Read module type %s\n" (s_type_path m.m_path) (s_type_path infos.mt_path); *)
 		infos.mt_private <- self#read_bool;
 		infos.mt_private <- self#read_bool;
 		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
 		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
 		infos.mt_meta <- self#read_metadata;
 		infos.mt_meta <- self#read_metadata;
-		(* Printf.eprintf "  read type parameters for %s\n" (s_type_path infos.mt_path); *)
-		self#read_type_parameters infos.mt_path (fun a ->
-			(* Printf.eprintf "  read type parameters for %s: %d\n" (s_type_path infos.mt_path) (Array.length a); *)
-			type_type_parameters <- a
-		);
+		self#read_type_parameters infos.mt_path (fun a -> type_type_parameters <- a);
 		infos.mt_params <- Array.to_list type_type_parameters;
 		infos.mt_params <- Array.to_list type_type_parameters;
 		infos.mt_using <- self#read_list (fun () ->
 		infos.mt_using <- self#read_list (fun () ->
 			let c = self#read_class_ref in
 			let c = self#read_class_ref in
@@ -1179,7 +1180,7 @@ class hxb_reader
 			(c,p)
 			(c,p)
 		)
 		)
 
 
-	method read_class_kind m = match self#read_u8 with
+	method read_class_kind = match self#read_u8 with
 		| 0 -> KNormal
 		| 0 -> KNormal
 		| 1 -> KTypeParameter self#read_types
 		| 1 -> KTypeParameter self#read_types
 		| 2 -> KExpr self#read_expr
 		| 2 -> KExpr self#read_expr
@@ -1196,9 +1197,8 @@ class hxb_reader
 			error (Printf.sprintf "Invalid class kind id: %i" i)
 			error (Printf.sprintf "Invalid class kind id: %i" i)
 
 
 	method read_class (c : tclass) =
 	method read_class (c : tclass) =
-		(* Printf.eprintf "  Read class %s\n" (s_type_path c.cl_path); *)
 		self#read_common_module_type (Obj.magic c);
 		self#read_common_module_type (Obj.magic c);
-		c.cl_kind <- self#read_class_kind m;
+		c.cl_kind <- self#read_class_kind;
 		c.cl_flags <- (Int32.to_int self#read_u32);
 		c.cl_flags <- (Int32.to_int self#read_u32);
 		let read_relation () =
 		let read_relation () =
 			let c = self#read_class_ref in
 			let c = self#read_class_ref in
@@ -1211,7 +1211,6 @@ class hxb_reader
 		c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
 		c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
 
 
 	method read_abstract (a : tabstract) =
 	method read_abstract (a : tabstract) =
-		(* Printf.eprintf "  Read abstract %s\n" (s_type_path a.a_path); *)
 		self#read_common_module_type (Obj.magic a);
 		self#read_common_module_type (Obj.magic a);
 		a.a_impl <- self#read_option (fun () -> self#read_class_ref);
 		a.a_impl <- self#read_option (fun () -> self#read_class_ref);
 		let impl = match a.a_impl with None -> null_class | Some c -> c in
 		let impl = match a.a_impl with None -> null_class | Some c -> c in
@@ -1221,8 +1220,6 @@ class hxb_reader
 			let name = self#read_string in
 			let name = self#read_string in
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			let t = self#read_type_instance in
 			let t = self#read_type_instance in
-			(* Printf.eprintf "  Read field ref for abstract from field %s (a = %s)\n" name (s_type_path a.a_path); *)
-			(* Printf.eprintf "   Impl has %d fields and %d statics\n" (List.length impl.cl_ordered_fields) (List.length impl.cl_ordered_statics); *)
 			let cf = self#read_field_ref impl.cl_statics in
 			let cf = self#read_field_ref impl.cl_statics in
 			(t,cf)
 			(t,cf)
 		);
 		);
@@ -1231,8 +1228,6 @@ class hxb_reader
 			let name = self#read_string in
 			let name = self#read_string in
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			let t = self#read_type_instance in
 			let t = self#read_type_instance in
-			(* Printf.eprintf "  Read field ref for abstract to field %s (a = %s)\n" name (s_type_path a.a_path); *)
-			(* Printf.eprintf "   Impl has %d fields and %d statics\n" (List.length impl.cl_ordered_fields) (List.length impl.cl_ordered_statics); *)
 			let cf = self#read_field_ref impl.cl_statics in
 			let cf = self#read_field_ref impl.cl_statics in
 			(t,cf)
 			(t,cf)
 		);
 		);
@@ -1244,13 +1239,11 @@ class hxb_reader
 		a.a_enum <- self#read_bool;
 		a.a_enum <- self#read_bool;
 
 
 	method read_enum (e : tenum) =
 	method read_enum (e : tenum) =
-		(* Printf.eprintf "  Read enum %s\n" (s_type_path e.e_path); *)
 		self#read_common_module_type (Obj.magic e);
 		self#read_common_module_type (Obj.magic e);
 		e.e_extern <- self#read_bool;
 		e.e_extern <- self#read_bool;
 		e.e_names <- self#read_list (fun () -> self#read_string);
 		e.e_names <- self#read_list (fun () -> self#read_string);
 
 
 	method read_typedef (td : tdef) =
 	method read_typedef (td : tdef) =
-		(* Printf.eprintf "  Reading typedef %s\n" (s_type_path td.t_path); *)
 		self#read_common_module_type (Obj.magic td);
 		self#read_common_module_type (Obj.magic td);
 		td.t_type <- self#read_type_instance;
 		td.t_type <- self#read_type_instance;
 
 
@@ -1361,10 +1354,8 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		let l = self#read_uleb128 in
 		classes <- (Array.init l (fun i ->
 		classes <- (Array.init l (fun i ->
 				let (pack,mname,tname) = self#read_full_path in
 				let (pack,mname,tname) = self#read_full_path in
-				(* Printf.eprintf "  Read clsr %d of %d for %s\n" i (l-1) (s_type_path ((pack @ [mname]),tname)); *)
 				match self#resolve_type pack mname tname with
 				match self#resolve_type pack mname tname with
 				| TClassDecl c ->
 				| TClassDecl c ->
-					(* Printf.eprintf "  Resolved %d = %s with %d fields and %d statics\n" i (s_type_path c.cl_path) (List.length c.cl_ordered_fields) (List.length c.cl_ordered_statics); *)
 					c
 					c
 				| _ ->
 				| _ ->
 					error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
 					error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
@@ -1374,7 +1365,6 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		let l = self#read_uleb128 in
 		abstracts <- (Array.init l (fun i ->
 		abstracts <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
 			let (pack,mname,tname) = self#read_full_path in
-			(* Printf.eprintf "  Read absr %d of %d for abstract %s\n" i l tname; *)
 			match self#resolve_type pack mname tname with
 			match self#resolve_type pack mname tname with
 			| TAbstractDecl a ->
 			| TAbstractDecl a ->
 				a
 				a
@@ -1386,7 +1376,6 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		let l = self#read_uleb128 in
 		enums <- (Array.init l (fun i ->
 		enums <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
 			let (pack,mname,tname) = self#read_full_path in
-			(* Printf.eprintf "  Read enmr %d of %d for enum %s\n" i l tname; *)
 			match self#resolve_type pack mname tname with
 			match self#resolve_type pack mname tname with
 			| TEnumDecl en ->
 			| TEnumDecl en ->
 				en
 				en
@@ -1398,7 +1387,6 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		let l = self#read_uleb128 in
 		typedefs <- (Array.init l (fun i ->
 		typedefs <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
 			let (pack,mname,tname) = self#read_full_path in
-			(* Printf.eprintf "  Read tpdr %d of %d for typedef %s\n" i l (s_type_path ((pack @ [mname]), tname)); *)
 			match self#resolve_type pack mname tname with
 			match self#resolve_type pack mname tname with
 			| TTypeDecl tpd ->
 			| TTypeDecl tpd ->
 				tpd
 				tpd
@@ -1490,8 +1478,7 @@ class hxb_reader
 	method read_hhdr =
 	method read_hhdr =
 		let path = self#read_path in
 		let path = self#read_path in
 		let file = self#read_string in
 		let file = self#read_string in
-		let m = make_module path file in
-		m
+		make_module path file
 
 
 	method read (debug : bool) (p : pos) =
 	method read (debug : bool) (p : pos) =
 		(* TODO: add magic & version to writer! *)
 		(* TODO: add magic & version to writer! *)

+ 79 - 28
src/compiler/hxb/hxbWriter.ml

@@ -10,7 +10,7 @@ let c_reset = if no_color then "" else "\x1b[0m"
 let c_bold = if no_color then "" else "\x1b[1m"
 let c_bold = if no_color then "" else "\x1b[1m"
 let c_dim = if no_color then "" else "\x1b[2m"
 let c_dim = if no_color then "" else "\x1b[2m"
 let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo = "\x1b[33m[TODO]" ^ c_reset
-let todo_error = "\x1b[41m[TODO] error:" ^ c_reset
+let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
 
 type field_source =
 type field_source =
 	| ClassStatic of tclass
 	| ClassStatic of tclass
@@ -58,6 +58,21 @@ let unop_index op flag = match op,flag with
 	| NegBits,Postfix -> 10
 	| NegBits,Postfix -> 10
 	| Spread,Postfix -> 11
 	| Spread,Postfix -> 11
 
 
+let print_stacktrace () =
+	let stack = Printexc.get_callstack 10 in
+	let lines = Printf.sprintf "%s\n" (Printexc.raw_backtrace_to_string stack) in
+	match (ExtString.String.split_on_char '\n' lines) with
+		| (_ :: (_ :: lines)) -> Printf.eprintf "%s" (ExtString.String.join "\n" lines)
+		| _ -> die "" __LOC__
+
+let print_types source tl =
+	Printf.eprintf "Types from %s: \n" source;
+	List.iter (fun t -> Printf.eprintf "  %s\n" (s_type_kind t)) tl
+
+let print_params source ttp =
+	Printf.eprintf "Params from %s: \n" source;
+	List.iter (fun t -> Printf.eprintf "  %s\n" t.ttp_name) ttp
+
 class ['key,'value] pool = object(self)
 class ['key,'value] pool = object(self)
 	val lut = Hashtbl.create 0
 	val lut = Hashtbl.create 0
 	val items = DynArray.create ()
 	val items = DynArray.create ()
@@ -211,9 +226,11 @@ class chunk
 end
 end
 
 
 class ['a] hxb_writer
 class ['a] hxb_writer
+	(com : Common.context)
 	(anon_id : Type.t tanon_identification)
 	(anon_id : Type.t tanon_identification)
 = object(self)
 = object(self)
 
 
+	val mutable current_module = null_module
 	val chunks = DynArray.create ()
 	val chunks = DynArray.create ()
 	val cp = new string_pool STRI
 	val cp = new string_pool STRI
 	val docs = new string_pool DOCS
 	val docs = new string_pool DOCS
@@ -233,7 +250,6 @@ class ['a] hxb_writer
 	val own_typedefs = new pool
 	val own_typedefs = new pool
 
 
 	val type_param_lut = new pool
 	val type_param_lut = new pool
-	val mutable ttp_key = None
 	val mutable type_type_parameters = new pool
 	val mutable type_type_parameters = new pool
 	val mutable field_type_parameters = new pool
 	val mutable field_type_parameters = new pool
 	val mutable local_type_parameters = []
 	val mutable local_type_parameters = []
@@ -309,10 +325,11 @@ class ['a] hxb_writer
 		(* Printf.eprintf "  Write abstract ref %d for %s\n" i (snd a.a_path); *)
 		(* Printf.eprintf "  Write abstract ref %d for %s\n" i (snd a.a_path); *)
 		chunk#write_uleb128 i
 		chunk#write_uleb128 i
 
 
-	method write_anon_ref (an : tanon) =
+	method write_anon_ref (an : tanon) (ttp : type_params) =
 		let pfm = Option.get (anon_id#identify true (TAnon an)) in
 		let pfm = Option.get (anon_id#identify true (TAnon an)) 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); *)
+		let ftp = field_type_parameters#to_list in
+		let ttp = ttp @ type_type_parameters#to_list in
+		let i = anons#get_or_add pfm.pfm_path (an,ttp,ftp) in
 		chunk#write_uleb128 i
 		chunk#write_uleb128 i
 
 
 	method write_field_ref (source : field_source) (cf : tclass_field) =
 	method write_field_ref (source : field_source) (cf : tclass_field) =
@@ -321,6 +338,22 @@ class ['a] hxb_writer
 	method write_enum_field_ref ef =
 	method write_enum_field_ref ef =
 		chunk#write_string ef.ef_name
 		chunk#write_string ef.ef_name
 
 
+	method write_anon_field_ref cf =
+		let ftp = field_type_parameters#to_list in
+		let ttp = type_type_parameters#to_list in
+
+		(* if (snd current_module.m_path) = "Main" then begin *)
+		(* 	List.iter (fun ttp -> Printf.eprintf "[%s] Anon field TTP %s for %s\n" (s_type_path current_module.m_path) ttp.ttp_name cf.cf_name) cf.cf_params; *)
+		(* 	List.iter (fun ttp -> Printf.eprintf "TTP %s %s for %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type) cf.cf_name) ttp; *)
+		(* 	List.iter (fun ttp -> Printf.eprintf "FTP %s %s for %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type) cf.cf_name) ftp; *)
+
+		(* 	if anon_fields#has cf then Printf.eprintf "Anon %s was already in anon_fields\n" cf.cf_name *)
+		(* 	else Printf.eprintf "Adding anon %s in anon_fields\n" cf.cf_name; *)
+		(* end; *)
+
+		let i = anon_fields#get_or_add cf (cf,ttp,ftp) in
+		chunk#write_uleb128 i
+
 	(* Type instances *)
 	(* Type instances *)
 
 
 	method write_type_parameter_ref (c : tclass) =
 	method write_type_parameter_ref (c : tclass) =
@@ -345,8 +378,10 @@ class ['a] hxb_writer
 			in
 			in
 			loop 0 local_type_parameters
 			loop 0 local_type_parameters
 		with Not_found ->
 		with Not_found ->
-			(* error ("Unbound type parameter " ^ (s_type_path c.cl_path)) *)
-			Printf.eprintf "%s Unbound type parameter %s\n" todo_error (s_type_path c.cl_path);
+			Printf.eprintf "[%s] %s Unbound type parameter %s (%s)\n" (s_type_path current_module.m_path) todo_error (s_type_path c.cl_path) (snd c.cl_path);
+			(* DynArray.iter (fun ttp -> Printf.eprintf "FTP %s %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type)) field_type_parameters#items; *)
+			(* DynArray.iter (fun ttp -> Printf.eprintf "TTP %s %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type)) type_type_parameters#items; *)
+			(* print_stacktrace (); *)
 			chunk#write_byte 40
 			chunk#write_byte 40
 		end
 		end
 
 
@@ -366,6 +401,7 @@ class ['a] hxb_writer
 				self#write_type_instance t
 				self#write_type_instance t
 			end
 			end
 		| TInst({cl_kind = KTypeParameter _} as c,[]) ->
 		| TInst({cl_kind = KTypeParameter _} as c,[]) ->
+			(* Printf.eprintf "[%s] KTypeParameter for %s\n" (s_type_path current_module.m_path) (s_type_path c.cl_path); *)
 			self#write_type_parameter_ref c
 			self#write_type_parameter_ref c
 		| TInst({cl_kind = KExpr e},[]) ->
 		| TInst({cl_kind = KExpr e},[]) ->
 			chunk#write_byte 8;
 			chunk#write_byte 8;
@@ -383,7 +419,7 @@ class ['a] hxb_writer
 					chunk#write_byte 0;
 					chunk#write_byte 0;
 				| TAnon an ->
 				| TAnon an ->
 					chunk#write_byte 1;
 					chunk#write_byte 1;
-					self#write_anon_ref an;
+					self#write_anon_ref an td.t_params
 				| _ ->
 				| _ ->
 					chunk#write_byte 2;
 					chunk#write_byte 2;
 					self#write_typedef_ref td;
 					self#write_typedef_ref td;
@@ -407,7 +443,7 @@ class ['a] hxb_writer
 					self#write_types tl
 					self#write_types tl
 				| TAnon an ->
 				| TAnon an ->
 					chunk#write_byte 1;
 					chunk#write_byte 1;
-					self#write_anon_ref an;
+					self#write_anon_ref an td.t_params;
 					self#write_types tl
 					self#write_types tl
 				| _ ->
 				| _ ->
 					chunk#write_byte 2;
 					chunk#write_byte 2;
@@ -440,7 +476,7 @@ class ['a] hxb_writer
 			chunk#write_bool true
 			chunk#write_bool true
 		| TAnon an ->
 		| TAnon an ->
 			chunk#write_byte 51;
 			chunk#write_byte 51;
-			self#write_anon_ref an;
+			self#write_anon_ref an []
 
 
 	method write_types tl =
 	method write_types tl =
 		chunk#write_list tl self#write_type_instance
 		chunk#write_list tl self#write_type_instance
@@ -807,7 +843,10 @@ class ['a] hxb_writer
 
 
 	method write_texpr (e : texpr) =
 	method write_texpr (e : texpr) =
 		let rec loop e =
 		let rec loop e =
-			self#write_type_instance e.etype;
+			(try self#write_type_instance e.etype; with _ -> begin
+				Printf.eprintf "Error while writing type instance for:\n";
+				MessageReporting.display_source_at com e.epos;
+			end);
 			self#write_pos e.epos;
 			self#write_pos e.epos;
 
 
 			match e.eexpr with
 			match e.eexpr with
@@ -982,7 +1021,7 @@ class ['a] hxb_writer
 			| TField(e1,FAnon cf) ->
 			| TField(e1,FAnon cf) ->
 				chunk#write_byte 104;
 				chunk#write_byte 104;
 				loop e1;
 				loop e1;
-				chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
+				self#write_anon_field_ref cf
 			| TField(e1,FClosure(Some(c,tl),cf)) ->
 			| TField(e1,FClosure(Some(c,tl),cf)) ->
 				chunk#write_byte 105;
 				chunk#write_byte 105;
 				loop e1;
 				loop e1;
@@ -992,12 +1031,15 @@ class ['a] hxb_writer
 			| TField(e1,FClosure(None,cf)) ->
 			| TField(e1,FClosure(None,cf)) ->
 				chunk#write_byte 106;
 				chunk#write_byte 106;
 				loop e1;
 				loop e1;
-				chunk#write_uleb128 (anon_fields#get_or_add cf (cf,type_type_parameters,field_type_parameters));
+				self#write_anon_field_ref cf
 			| TField(e1,FEnum(en,ef)) ->
 			| TField(e1,FEnum(en,ef)) ->
 				chunk#write_byte 107;
 				chunk#write_byte 107;
 				loop e1;
 				loop e1;
 				self#write_enum_ref en;
 				self#write_enum_ref en;
 				self#write_enum_field_ref ef;
 				self#write_enum_field_ref ef;
+				(* TODO ef.ef_params here triggers unbound type params later *)
+				chunk#write_list ef.ef_params self#write_type_parameter_forward;
+				chunk#write_list ef.ef_params self#write_type_parameter_data;
 			| TField(e1,FDynamic s) ->
 			| TField(e1,FDynamic s) ->
 				chunk#write_byte 108;
 				chunk#write_byte 108;
 				loop e1;
 				loop e1;
@@ -1120,11 +1162,15 @@ class ['a] hxb_writer
 		self#set_field_type_parameters cf.cf_params;
 		self#set_field_type_parameters cf.cf_params;
 		local_type_parameters <- [];
 		local_type_parameters <- [];
 		let restore = self#start_temporary_chunk in
 		let restore = self#start_temporary_chunk in
-		(* Printf.eprintf " Write class field %s\n" cf.cf_name; *)
+		(* if (snd current_module.m_path) = "Main" then *)
+		(* 	Printf.eprintf " (1) Write class field %s\n" cf.cf_name; *)
 		chunk#write_string cf.cf_name;
 		chunk#write_string cf.cf_name;
 		chunk#write_list cf.cf_params self#write_type_parameter_forward;
 		chunk#write_list cf.cf_params self#write_type_parameter_forward;
 		chunk#write_list cf.cf_params self#write_type_parameter_data;
 		chunk#write_list cf.cf_params self#write_type_parameter_data;
-		self#write_type_instance cf.cf_type;
+		(try self#write_type_instance cf.cf_type with e -> begin
+			Printf.eprintf "%s while writing type instance for field %s\n" todo_error cf.cf_name;
+			raise e
+		end);
 		chunk#write_i32 cf.cf_flags;
 		chunk#write_i32 cf.cf_flags;
 		if with_pos then begin
 		if with_pos then begin
 			self#write_pos cf.cf_pos;
 			self#write_pos cf.cf_pos;
@@ -1133,7 +1179,11 @@ class ['a] hxb_writer
 		chunk#write_option cf.cf_doc self#write_documentation;
 		chunk#write_option cf.cf_doc self#write_documentation;
 		self#write_metadata cf.cf_meta;
 		self#write_metadata cf.cf_meta;
 		self#write_field_kind cf.cf_kind;
 		self#write_field_kind cf.cf_kind;
-		chunk#write_option cf.cf_expr self#write_texpr;
+		(try chunk#write_option cf.cf_expr self#write_texpr with e -> begin
+			Printf.eprintf "%s while writing expr for field %s\n" todo_error cf.cf_name;
+			MessageReporting.display_source_at com cf.cf_pos;
+			raise e
+		end);
 		chunk#write_option cf.cf_expr_unoptimized self#write_texpr;
 		chunk#write_option cf.cf_expr_unoptimized self#write_texpr;
 		chunk#write_list cf.cf_overloads (self#write_class_field ~with_pos:true);
 		chunk#write_list cf.cf_overloads (self#write_class_field ~with_pos:true);
 		restore (fun chunk new_chunk ->
 		restore (fun chunk new_chunk ->
@@ -1144,7 +1194,6 @@ class ['a] hxb_writer
 
 
 	method select_type (path : path) =
 	method select_type (path : path) =
 		(* Printf.eprintf "Select type %s\n" (s_type_path path); *)
 		(* Printf.eprintf "Select type %s\n" (s_type_path path); *)
-		ttp_key <- Some path;
 		type_type_parameters <- type_param_lut#extract path
 		type_type_parameters <- type_param_lut#extract path
 
 
 	method write_common_module_type (infos : tinfos) : unit =
 	method write_common_module_type (infos : tinfos) : unit =
@@ -1193,7 +1242,8 @@ class ['a] hxb_writer
 		| _ ->
 		| _ ->
 			self#select_type c.cl_path;
 			self#select_type c.cl_path;
 		end;
 		end;
-		(* Printf.eprintf "Write class %s with %d type params\n" (snd c.cl_path) (List.length c.cl_params); *)
+		(* if (snd current_module.m_path) = "Bar_String" then *)
+		(* Printf.eprintf "[%s] Write class %s with %d type params\n" (s_type_path current_module.m_path) (snd c.cl_path) (List.length c.cl_params); *)
 		self#write_common_module_type (Obj.magic c);
 		self#write_common_module_type (Obj.magic c);
 		self#write_class_kind c.cl_kind;
 		self#write_class_kind c.cl_kind;
 		chunk#write_u32 (Int32.of_int c.cl_flags);
 		chunk#write_u32 (Int32.of_int c.cl_flags);
@@ -1262,15 +1312,15 @@ class ['a] hxb_writer
 		self#write_common_module_type (Obj.magic td);
 		self#write_common_module_type (Obj.magic td);
 		self#write_type_instance td.t_type;
 		self#write_type_instance td.t_type;
 
 
-	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
+	method write_anon (m : module_def) ((an : tanon), (ttp : type_params), (ftp : type_params)) =
+		type_type_parameters <- new pool;
+		List.iter (fun ttp -> ignore(type_type_parameters#add ttp.ttp_name ttp)) ttp;
 		chunk#write_list ttp self#write_type_parameter_forward;
 		chunk#write_list ttp self#write_type_parameter_forward;
 		chunk#write_list ttp self#write_type_parameter_data;
 		chunk#write_list ttp self#write_type_parameter_data;
 
 
 		let write_fields () =
 		let write_fields () =
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) an.a_fields []) (fun (_,cf) ->
 			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 with cf_params = (cf.cf_params @ ftp#to_list) };
+				self#write_class_field ~with_pos:true { cf with cf_params = (cf.cf_params @ ftp) };
 			)
 			)
 		in
 		in
 
 
@@ -1357,7 +1407,7 @@ class ['a] hxb_writer
 				chunk#write_byte 0;
 				chunk#write_byte 0;
 			| TAnon an ->
 			| TAnon an ->
 				chunk#write_byte 1;
 				chunk#write_byte 1;
-				self#write_anon_ref an;
+				self#write_anon_ref an e.e_type.t_params
 			| _ -> assert false);
 			| _ -> assert false);
 
 
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
@@ -1375,6 +1425,7 @@ class ['a] hxb_writer
 			()
 			()
 
 
 	method write_module (m : module_def) =
 	method write_module (m : module_def) =
+		current_module <- m;
 		self#start_chunk HHDR;
 		self#start_chunk HHDR;
 		self#write_path m.m_path;
 		self#write_path m.m_path;
 		chunk#write_string (Path.UniqueKey.lazy_path m.m_extra.m_file);
 		chunk#write_string (Path.UniqueKey.lazy_path m.m_extra.m_file);
@@ -1382,6 +1433,7 @@ class ['a] hxb_writer
 		self#start_chunk TYPF;
 		self#start_chunk TYPF;
 		chunk#write_list m.m_types self#forward_declare_type;
 		chunk#write_list m.m_types self#forward_declare_type;
 
 
+		(* if (snd current_module.m_path) = "Issue3090" then *)
 		(* Printf.eprintf "Write module %s with %d own classes, %d own abstracts, %d own enums, %d own typedefs\n" *)
 		(* Printf.eprintf "Write module %s with %d own classes, %d own abstracts, %d own enums, %d own typedefs\n" *)
 		(* 	(snd m.m_path) (List.length own_classes#to_list) (List.length own_abstracts#to_list) (List.length own_enums#to_list) (List.length own_typedefs#to_list); *)
 		(* 	(snd m.m_path) (List.length own_classes#to_list) (List.length own_abstracts#to_list) (List.length own_enums#to_list) (List.length own_typedefs#to_list); *)
 
 
@@ -1422,6 +1474,7 @@ class ['a] hxb_writer
 			self#start_chunk EFLD;
 			self#start_chunk EFLD;
 			chunk#write_list own_enums (fun e ->
 			chunk#write_list own_enums (fun e ->
 				chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
 				chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
+					self#select_type e.e_path;
 					(* Printf.eprintf "  Write enum field %s.%s\n" (s_type_path e.e_path) s; *)
 					(* Printf.eprintf "  Write enum field %s.%s\n" (s_type_path e.e_path) s; *)
 					chunk#write_string s;
 					chunk#write_string s;
 					self#set_field_type_parameters ef.ef_params;
 					self#set_field_type_parameters ef.ef_params;
@@ -1455,13 +1508,11 @@ class ['a] hxb_writer
 			);
 			);
 			self#start_chunk ANFD;
 			self#start_chunk ANFD;
 			chunk#write_list l (fun (cf,ttp,ftp) ->
 			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
+				type_type_parameters <- new pool;
+				List.iter (fun ttp -> ignore(type_type_parameters#add ttp.ttp_name ttp)) ttp;
 				chunk#write_list ttp self#write_type_parameter_forward;
 				chunk#write_list ttp self#write_type_parameter_forward;
 				chunk#write_list ttp self#write_type_parameter_data;
 				chunk#write_list ttp self#write_type_parameter_data;
-				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp#to_list) };
-				(* Printf.eprintf "Write anon field %s (done)\n" cf.cf_name; *)
+				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp) };
 			);
 			);
 		end;
 		end;
 
 

+ 1 - 0
src/filters/filters.ml

@@ -938,6 +938,7 @@ let run tctx main =
 		end;
 		end;
 		not cached
 		not cached
 	) com.types in
 	) com.types in
+	Printf.eprintf "%d new types\n" (List.length new_types);
 	(* IMPORTANT:
 	(* IMPORTANT:
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 		because they received an additional dependency. This could happen in cases such as @:generic methods in #10635.
 		because they received an additional dependency. This could happen in cases such as @:generic methods in #10635.

+ 2 - 0
src/typing/typeloadModule.ml

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