[hxb] tanon changes, debug, prepare for server

src/compiler/generate.ml

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

src/compiler/hxb/hxbReader.ml

@@ -11,16 +11,26 @@ let c_dim = if no_color then "" else "\x1b[2m"
 let todo = "\x1b[33m[TODO]" ^ c_reset
 let todo_error = "\x1b[31m[TODO] error:" ^ c_reset
 
+let debug_msg msg =
+	prerr_endline msg
+
+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)) -> prerr_endline (Printf.sprintf "%s" (ExtString.String.join "\n" lines))
+		| _ -> die "" __LOC__
+
 class hxb_reader
-	(com : Common.context)
-	(file_ch : IO.input)
+	(* (com : Common.context) *)
 	(make_module : path -> string -> module_def)
 	(add_module : module_def -> unit)
-	(resolve_type : string list -> string -> string -> module_type)
+	(resolve_type : string -> string list -> string -> string -> module_type)
+	(flush_fields : unit -> unit)
 = object(self)
 
 	val mutable m = null_module
-	val mutable ch = file_ch
+	val mutable ch = IO.input_bytes Bytes.empty
 	val mutable string_pool = Array.make 0 ""
 	val mutable doc_pool = Array.make 0 ""
 
@@ -36,8 +46,8 @@ class hxb_reader
 	val mutable field_type_parameters = Array.make 0 (mk_type_param "" t_dynamic None)
 	val mutable local_type_parameters = Array.make 0 (mk_type_param "" t_dynamic None)
 
-	method resolve_type pack mname tname =
-		try resolve_type pack mname tname with
+	method resolve_type sign pack mname tname =
+		try resolve_type sign pack mname tname with
 		| Not_found -> error (Printf.sprintf "Cannot resolve type %s" (s_type_path ((pack @ [mname]),tname)))
 
 	val mutable tvoid = None
@@ -45,7 +55,7 @@ class hxb_reader
 		match tvoid with
 		| Some tvoid -> tvoid
 		| None ->
-				let t = type_of_module_type (self#resolve_type [] "StdTypes" "Void") in
+				let t = type_of_module_type (self#resolve_type m.m_extra.m_sign [] "StdTypes" "Void") in
 				tvoid <- Some t;
 				t
 
@@ -92,7 +102,7 @@ class hxb_reader
 	method read_from_string_pool pool =
 		let l = self#read_uleb128 in
 		try pool.(l) with e ->
-			Printf.eprintf "  Failed getting string #%d\n" l;
+			prerr_endline (Printf.sprintf "  Failed getting string #%d" l);
 			raise e
 
 	method read_string =
@@ -125,7 +135,7 @@ class hxb_reader
 		let pack = self#read_list (fun () -> self#read_string) in
 		let mname = self#read_string in
 		let tname = self#read_string in
-		(* Printf.eprintf "    Read full path %s\n" (ExtString.String.join "." (pack @ [mname; tname])); *)
+		(* prerr_endline (Printf.sprintf "    Read full path %s" (ExtString.String.join "." (pack @ [mname; tname]))); *)
 		(pack,mname,tname)
 
 	method read_documentation =
@@ -146,7 +156,7 @@ class hxb_reader
 			pmin = min;
 			pmax = max;
 		} in
-		(* Printf.eprintf "Read pos: %s\n" (Printer.s_pos pos); *)
+		(* prerr_endline (Printf.sprintf "Read pos: %s" (Printer.s_pos pos)); *)
 		(* MessageReporting.display_source_at com pos; *)
 		pos
 
@@ -163,49 +173,67 @@ class hxb_reader
 
 	method read_class_ref =
 		let i = self#read_uleb128 in
-		classes.(i)
+		try classes.(i) with e ->
+			prerr_endline (Printf.sprintf "[%s] %s reading class ref %i" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_abstract_ref =
 		let i = self#read_uleb128 in
-		abstracts.(i)
+		try abstracts.(i) with e ->
+			prerr_endline (Printf.sprintf "[%s] %s reading abstract ref %i" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_enum_ref =
 		let i = self#read_uleb128 in
-		enums.(i)
+		try enums.(i) with e ->
+			prerr_endline (Printf.sprintf "[%s] %s reading enum ref %i" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_typedef_ref =
 		let i = self#read_uleb128 in
-		typedefs.(i)
+		try typedefs.(i) with e ->
+			prerr_endline (Printf.sprintf "[%s] %s reading typedef ref %i" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_anon_ref =
 		let i = self#read_uleb128 in
-		(* Printf.eprintf " Read anon ref %d of %d\n" i ((Array.length anons) - 1); *)
-		anons.(i)
+		try anons.(i) with e ->
+			prerr_endline (Printf.sprintf "[%s] %s reading anon ref %i" (s_type_path m.m_path) todo_error i);
+			raise e
 
 	method read_field_ref fields =
 		let name = self#read_string in
 		try PMap.find name fields with e ->
-			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 "");
+			prerr_endline (Printf.sprintf "[%s]  %s reading field %s" (s_type_path m.m_path) todo_error name);
+			prerr_endline (Printf.sprintf "    Available fields: %s" (PMap.fold (fun f acc -> acc ^ " " ^ f.cf_name) fields ""));
+			print_stacktrace ();
 			null_field
 
 	method read_enum_field_ref en =
 		let name = self#read_string in
 		try PMap.find name en.e_constrs with e ->
-			Printf.eprintf "  %s reading enum field ref for %s.%s\n" todo_error (s_type_path en.e_path) name;
-			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs "");
+			prerr_endline (Printf.sprintf "  %s reading enum field ref for %s.%s" todo_error (s_type_path en.e_path) name);
+			prerr_endline (Printf.sprintf "    Available fields: %s" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs ""));
 			null_enum_field
 
 	method read_anon_field_ref =
 		match IO.read_byte ch with
 		| 0 ->
 			let index = self#read_uleb128 in
-			anon_fields.(index)
+			(try anon_fields.(index) with e ->
+				prerr_endline (Printf.sprintf "[%s] %s reading anon field (0) ref %i" (s_type_path m.m_path) todo_error index);
+				raise e
+			)
 		| 1 ->
 			let index = self#read_uleb128 in
-			let cf = self#read_class_field true in
-			anon_fields.(index) <- cf;
-			cf
+			(try begin
+				let cf = self#read_class_field true in
+				anon_fields.(index) <- cf;
+				cf
+			end with e ->
+				prerr_endline (Printf.sprintf "[%s] %s reading anon field (1) ref %i" (s_type_path m.m_path) todo_error index);
+				raise e
+			)
 		| _ ->
 			assert false
 
@@ -607,14 +635,14 @@ class hxb_reader
 
 	method read_type_instance =
 		let kind = self#read_u8 in
-		(* Printf.eprintf "   Read type instance %d\n" kind; *)
+		(* prerr_endline (Printf.sprintf "   Read type instance %d" kind); *)
 
 		match kind with
 		| 0 ->
-			(* Printf.eprintf "  %s identity\n" todo; *)
+			(* prerr_endline (Printf.sprintf "  %s identity" todo); *)
 			mk_mono() (* TODO: identity *)
 		| 1 ->
-			(* Printf.eprintf "  %s TMono Some\n" todo; *)
+			(* prerr_endline (Printf.sprintf "  %s TMono Some" todo); *)
 			let t = self#read_type_instance in
 			let tmono = !monomorph_create_ref () in (* TODO identity *)
 			tmono.tm_type <- Some t;
@@ -629,7 +657,9 @@ class hxb_reader
 			TEnum(self#read_enum_ref,[])
 		| 12 ->
 			begin match self#read_u8 with
-				(* TODO wrap those two in TType? *)
+				(* TODO does it make more sense to wrap in tdef like in source? *)
+				(* | 0 -> TType({null_typedef with t_type = (mk_anon (ref Closed))},[]) *)
+				(* | 1 -> TType({null_typedef with t_type = (TAnon self#read_anon_ref)},[]) *)
 				| 0 -> mk_anon (ref Closed)
 				| 1 -> TAnon self#read_anon_ref
 				| _ -> TType(self#read_typedef_ref,[])
@@ -656,10 +686,19 @@ class hxb_reader
 					let tl = self#read_types in
 					let td = { null_typedef with t_type = an } in
 					TType(td,tl)
+				(* TODO: does this help with anything? *)
+				(* | 2 -> *)
+				(* 	let t = self#read_type_instance in *)
+				(* 	let tl = self#read_types in *)
+				(* 	let tmono = !monomorph_create_ref () in (1* TODO identity *1) *)
+				(* 	tmono.tm_type <- Some t; *)
+				(* 	let td = { null_typedef with t_type = TMono tmono } in *)
+				(* 	TType(td,tl) *)
 				| _ ->
-					let t = self#read_typedef_ref in
+					let t = self#read_type_instance in
 					let tl = self#read_types in
-					TType(t,tl)
+					let td = { null_typedef with t_type = t } in
+					TType(td,tl)
 			end
 		| 17 ->
 			let a = self#read_abstract_ref in
@@ -669,7 +708,7 @@ class hxb_reader
 		| 31 ->
 			let f () =
 				let name = self#read_string in
-				(* Printf.eprintf "  Read type instance for %s\n" name; *)
+				(* prerr_endline (Printf.sprintf "  Read type instance for %s" name); *)
 				let opt = self#read_bool in
 				let t = self#read_type_instance in
 				(name,opt,t)
@@ -679,13 +718,13 @@ class hxb_reader
 		| 32 ->
 			let f () =
 				let name = self#read_string in
-				(* Printf.eprintf "  Read type instance for %s\n" name; *)
+				(* prerr_endline (Printf.sprintf "  Read type instance for %s" name); *)
 				let opt = self#read_bool in
 				let t = self#read_type_instance in
 				(name,opt,t)
 			in
 			let args = self#read_list f in
-			(* Printf.eprintf "  Read type instance for TFun\n"; *)
+			(* prerr_endline (Printf.sprintf "  Read type instance for TFun"); *)
 			let ret = self#read_type_instance in
 			TFun(args,ret)
 		| 33 ->
@@ -713,8 +752,8 @@ class hxb_reader
 		let a = Array.init l (fun _ ->
 			let name = self#read_string in
 			let pos = self#read_pos in
-			(* Printf.eprintf "      Read ttp pos for %s: %s\n" name (Printer.s_pos pos); *)
-			(* Printf.eprintf "      - Path was %s\n" (s_type_path path); *)
+			(* prerr_endline (Printf.sprintf "      Read ttp pos for %s: %s" name (Printer.s_pos pos)); *)
+			(* prerr_endline (Printf.sprintf "      - Path was %s" (s_type_path path)); *)
 			let c = mk_class m (fst path @ [snd path],name) pos pos in
 			mk_type_param name (TInst(c,[])) None
 		) in
@@ -838,7 +877,7 @@ class hxb_reader
 		let pos = self#read_pos in
 
 		let i = IO.read_byte ch in
-		(* Printf.eprintf "      -- texpr [%d] --\n" i; *)
+		(* prerr_endline (Printf.sprintf "      -- texpr [%d] --" i); *)
 		let e = match i with
 			(* values 0-19 *)
 			| 0 -> TConst TNull
@@ -969,7 +1008,6 @@ class hxb_reader
 			| 101 ->
 				let e1 = self#read_texpr in
 				let en = self#read_enum_ref in
-				(* PMap.iter (fun k _-> Printf.eprintf "    -> %s\n" k) en.e_constrs; *)
 				let ef = self#read_enum_field_ref en in
 				let i = IO.read_i32 ch in
 				TEnumParameter(e1,ef,i)
@@ -977,13 +1015,11 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				(* Printf.eprintf "  Read field ref for expr 102 (cl = %s, %d fields)\n" (s_type_path c.cl_path) (List.length c.cl_ordered_fields); *)
 				let cf = self#read_field_ref c.cl_fields in
 				TField(e1,FInstance(c,tl,cf))
 			| 103 ->
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
-				(* Printf.eprintf "  Read field ref for expr 103 (cl = %s)\n" (s_type_path c.cl_path); *)
 				let cf = self#read_field_ref c.cl_statics in
 				TField(e1,FStatic(c,cf))
 			| 104 ->
@@ -994,7 +1030,6 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				(* Printf.eprintf "  Read field ref for expr 105 (cl = %s)\n" (s_type_path c.cl_path); *)
 				let cf = self#read_field_ref c.cl_fields in
 				TField(e1,FClosure(Some(c,tl),cf))
 			| 106 ->
@@ -1023,7 +1058,8 @@ class hxb_reader
 			| 125 ->
 				let e1 = self#read_texpr in
 				let (pack,mname,tname) = self#read_full_path in
-				let md = self#resolve_type pack mname tname in
+				let sign = self#read_string in
+				let md = self#resolve_type sign pack mname tname in
 				TCast(e1,Some md)
 			| 126 ->
 				let c = self#read_class_ref in
@@ -1060,12 +1096,12 @@ class hxb_reader
 			| 250 -> TIdent (self#read_string)
 
 			| i ->
-				Printf.eprintf "  [ERROR] Unhandled texpr %d at:\n" i;
-				MessageReporting.display_source_at com pos;
+				prerr_endline (Printf.sprintf "  [ERROR] Unhandled texpr %d at:" i);
+				(* MessageReporting.display_source_at com pos; *)
 				assert false
 		in
 
-		(* Printf.eprintf "   Done reading texpr at:\n"; *)
+		(* prerr_endline (Printf.sprintf "   Done reading texpr at:"); *)
 		(* MessageReporting.display_source_at com pos; *)
 
 		{
@@ -1087,7 +1123,7 @@ class hxb_reader
 
 	method read_class_field_data (nested : bool) (cf : tclass_field) : unit =
 		let name = cf.cf_name in
-		(* Printf.eprintf "  Read class field %s\n" name; *)
+		(* prerr_endline (Printf.sprintf "  Read class field %s" name); *)
 		self#read_type_parameters ([],name) (fun a ->
 			field_type_parameters <- if nested then Array.append field_type_parameters a else a
 		);
@@ -1103,7 +1139,12 @@ class hxb_reader
 		let meta = self#read_metadata in
 		let kind = self#read_field_kind in
 
-		let expr = self#read_option (fun () -> self#read_texpr) in
+		let expr = try
+			self#read_option (fun () -> self#read_texpr)
+		with e ->
+			prerr_endline (Printf.sprintf "Error reading field expr for %s" cf.cf_name);
+			raise e
+		in
 		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
 
 		let l = self#read_uleb128 in
@@ -1133,8 +1174,8 @@ class hxb_reader
 		| _ ->
 			type_type_parameters <- Array.of_list c.cl_params
 		end;
-		(* Printf.eprintf "  read class fields with type parameters for %s: %d\n" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
-		(* Printf.eprintf "    own class params: %d\n" (List.length c.cl_params); *)
+		(* prerr_endline (Printf.sprintf "  read class fields with type parameters for %s: %d" (s_type_path c.cl_path) (Array.length type_type_parameters); *)
+		(* prerr_endline (Printf.sprintf "    own class params: %d" (List.length c.cl_params); *)
 		let _ = self#read_option (fun f ->
 			self#read_class_field_data false (Option.get c.cl_constructor)
 		) in
@@ -1152,7 +1193,7 @@ class hxb_reader
 		type_type_parameters <- Array.of_list e.e_params;
 		ignore(self#read_list (fun () ->
 			let name = self#read_string in
-			(* Printf.eprintf "  Read enum field %s\n" name; *)
+			(* prerr_endline (Printf.sprintf "  Read enum field %s" name); *)
 			let ef = PMap.find name e.e_constrs in
 			self#read_type_parameters ([],name) (fun a -> field_type_parameters <- a);
 			ef.ef_params <- Array.to_list field_type_parameters;
@@ -1165,7 +1206,7 @@ class hxb_reader
 
 	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); *)
+		(* prerr_endline (Printf.sprintf "[%s] Read module type %s" (s_type_path m.m_path) (s_type_path infos.mt_path)); *)
 		infos.mt_private <- self#read_bool;
 		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
 		infos.mt_meta <- self#read_metadata;
@@ -1248,7 +1289,7 @@ class hxb_reader
 
 	method read_string_pool =
 		let l = self#read_uleb128 in
-		(* Printf.eprintf "  Read string pool of size %d\n" l; *)
+		(* prerr_endline (Printf.sprintf "  Read string pool of size %d" l); *)
 		Array.init l (fun i ->
 			self#read_raw_string;
 		);
@@ -1259,7 +1300,7 @@ class hxb_reader
 		let data = IO.nread ch size in
 		let crc = self#read_u32 in
 		ignore(crc); (* TODO *)
-		(* Printf.eprintf "%s check crc (%d)\n" todo (Int32.to_int crc); *)
+		(* prerr_endline (Printf.sprintf "%s check crc (%d)" todo (Int32.to_int crc)); *)
 		let kind = chunk_kind_of_string name in
 		(kind,data)
 
@@ -1342,7 +1383,8 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		classes <- (Array.init l (fun i ->
 				let (pack,mname,tname) = self#read_full_path in
-				match self#resolve_type pack mname tname with
+				let sign = self#read_string in
+				match self#resolve_type sign pack mname tname with
 				| TClassDecl c ->
 					c
 				| _ ->
@@ -1353,7 +1395,8 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		abstracts <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
-			match self#resolve_type pack mname tname with
+			let sign = self#read_string in
+			match self#resolve_type sign pack mname tname with
 			| TAbstractDecl a ->
 				a
 			| _ ->
@@ -1364,7 +1407,8 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		enums <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
-			match self#resolve_type pack mname tname with
+			let sign = self#read_string in
+			match self#resolve_type sign pack mname tname with
 			| TEnumDecl en ->
 				en
 			| _ ->
@@ -1375,7 +1419,8 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		typedefs <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
-			match self#resolve_type pack mname tname with
+			let sign = self#read_string in
+			match self#resolve_type sign pack mname tname with
 			| TTypeDecl tpd ->
 				tpd
 			| _ ->
@@ -1384,7 +1429,6 @@ class hxb_reader
 
 	method read_annr =
 		let l = self#read_uleb128 in
-		(* Printf.eprintf "ANNR - %d\n" l; *)
 		anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed });
 
 	method read_typf =
@@ -1407,7 +1451,7 @@ class hxb_reader
 				c.cl_constructor <- self#read_option read_field;
 				c.cl_ordered_fields <- self#read_list read_field;
 				c.cl_ordered_statics <- self#read_list read_field;
-				(* Printf.eprintf "  Forward declare %s with %d fields, %d statics\n" (s_type_path path) (List.length c.cl_ordered_fields) (List.length c.cl_ordered_statics); *)
+				(* prerr_endline (Printf.sprintf "  Forward declare %s with %d fields, %d statics\n" (s_type_path path) (List.length c.cl_ordered_fields) (List.length c.cl_ordered_statics)); *)
 				List.iter (fun cf -> c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields) c.cl_ordered_fields;
 				List.iter (fun cf -> c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics) c.cl_ordered_statics;
 
@@ -1453,10 +1497,11 @@ class hxb_reader
 	method read_hhdr =
 		let path = self#read_path in
 		let file = self#read_string in
+		(* prerr_endline (Printf.sprintf "Read hxb module %s" (s_type_path path)); *)
 		anon_fields <- Array.make (self#read_uleb128) null_field;
 		make_module path file
 
-	method read (debug : bool) (p : pos) =
+	method read (file_ch : IO.input) (debug : bool) (p : pos) =
 		(* TODO: add magic & version to writer! *)
 		(* if (Bytes.to_string (IO.nread ch 3)) <> "hxb" then *)
 		(* 	raise (HxbFailure "magic"); *)
@@ -1496,7 +1541,7 @@ class hxb_reader
 		let chunks = pass_0 chunks in
 		assert(m != null_module);
 		List.iter (fun (kind,data) ->
-			(* Printf.eprintf " Reading chunk %s\n" (string_of_chunk_kind kind); *)
+			(* prerr_endline (Printf.sprintf " Reading chunk %s" (string_of_chunk_kind kind)); *)
 			ch <- IO.input_bytes data;
 			match kind with
 			| TYPF ->
@@ -1517,6 +1562,7 @@ class hxb_reader
 			| CLSD ->
 				self#read_clsd;
 			| CFLD ->
+				flush_fields ();
 				self#read_cfld;
 			| ENMD ->
 				self#read_enmd;
@@ -1529,5 +1575,6 @@ class hxb_reader
 			| _ ->
 				error ("Unexpected late chunk: " ^ (string_of_chunk_kind kind))
 		) chunks;
+		(* prerr_endline (Printf.sprintf "Done reading hxb module %s" (s_type_path m.m_path)); *)
 		m
 end

src/compiler/hxb/hxbWriter.ml

@@ -58,20 +58,23 @@ let unop_index op flag = match op,flag with
 	| NegBits,Postfix -> 10
 	| Spread,Postfix -> 11
 
+let debug_msg msg =
+	prerr_endline msg
+
 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)
+		| (_ :: (_ :: lines)) -> debug_msg (Printf.sprintf "%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
+	debug_msg (Printf.sprintf "Types from %s:" source);
+	List.iter (fun t -> debug_msg (Printf.sprintf "  %s" (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
+	debug_msg (Printf.sprintf "Params from %s:" source);
+	List.iter (fun t -> debug_msg (Printf.sprintf "  %s" t.ttp_name)) ttp
 
 class ['key,'value] pool = object(self)
 	val lut = Hashtbl.create 0
@@ -243,7 +246,7 @@ class chunk
 end
 
 class ['a] hxb_writer
-	(com : Common.context)
+	(* (com : Common.context) *)
 	(anon_id : Type.t Tanon_identification.tanon_identification)
 = object(self)
 
@@ -274,7 +277,7 @@ class ['a] hxb_writer
 	(* Chunks *)
 
 	method start_chunk (kind : chunk_kind) =
-		(* Printf.eprintf "Writing chunk %s\n" (string_of_chunk_kind kind); *)
+		(* debug_msg (Printf.sprintf "Writing chunk %s" (string_of_chunk_kind kind)); *)
 		let new_chunk = new chunk kind cp in
 		DynArray.add chunks new_chunk;
 		chunk <- new_chunk
@@ -308,9 +311,11 @@ class ['a] hxb_writer
 		);
 
 	method write_pos (p : pos) =
+		(* let t = Timer.timer ["server";"cache context";"write module";"write pos"] in *)
 		chunk#write_string p.pfile;
 		chunk#write_leb128 p.pmin;
 		chunk#write_leb128 p.pmax;
+		(* t() *)
 
 	method write_metadata_entry ((meta,el,p) : metadata_entry) =
 		chunk#write_string (Meta.to_string meta);
@@ -324,22 +329,22 @@ class ['a] hxb_writer
 
 	method write_class_ref (c : tclass) =
 		let i = classes#get_or_add c.cl_path c in
-		(* Printf.eprintf "  Write class ref %d for %s\n" i (snd c.cl_path); *)
+		(* debug_msg (Printf.sprintf "  Write class ref %d for %s" i (snd c.cl_path)); *)
 		chunk#write_uleb128 i
 
 	method write_enum_ref (en : tenum) =
 		let i = enums#get_or_add en.e_path en in
-		(* Printf.eprintf "  Write enum ref %d for %s\n" i (snd en.e_path); *)
+		(* debug_msg (Printf.sprintf "  Write enum ref %d for %s" i (snd en.e_path)); *)
 		chunk#write_uleb128 i
 
 	method write_typedef_ref (td : tdef) =
 		let i = typedefs#get_or_add td.t_path td in
-		(* Printf.eprintf "  Write typedef ref %d for %s\n" i (s_type_path td.t_path); *)
+		(* debug_msg (Printf.sprintf "  Write typedef ref %d for %s" i (s_type_path td.t_path)); *)
 		chunk#write_uleb128 i
 
 	method write_abstract_ref (a : tabstract) =
 		let i = abstracts#get_or_add a.a_path a in
-		(* Printf.eprintf "  Write abstract ref %d for %s\n" i (snd a.a_path); *)
+		(* debug_msg (Printf.sprintf "  Write abstract ref %d for %s" i (snd a.a_path)); *)
 		chunk#write_uleb128 i
 
 	method write_anon_ref (an : tanon) (ttp : type_params) =
@@ -386,18 +391,22 @@ class ['a] hxb_writer
 			chunk#write_byte 7;
 			chunk#write_uleb128 index;
 		with Not_found ->
-			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; *)
+			prerr_endline (Printf.sprintf "[%s] %s Unbound type parameter %s (%s)" (s_type_path current_module.m_path) todo_error (s_type_path c.cl_path) (snd c.cl_path));
+			(* DynArray.iter (fun ttp -> debug_msg (Printf.sprintf "FTP %s %s" ttp.ttp_name (s_type_kind ttp.ttp_type)) field_type_parameters#items); *)
+			(* DynArray.iter (fun ttp -> debug_msg (Printf.sprintf "TTP %s %s" ttp.ttp_name (s_type_kind ttp.ttp_type)) type_type_parameters#items); *)
 			(* print_stacktrace (); *)
-			chunk#write_byte 40
+			chunk#write_byte 0 (* TMono None *)
 		end
 
-	method write_type_instance t =
+	method write_type_instance ?(debug:bool = false) t =
+		let debug_trace = (fun _ -> ()) in
+		(* let debug_trace = if debug then (fun s -> trace s) else (fun _ -> ()) in *)
+		ignore(debug_trace);
+
 		let write_function_arg (n,o,t) =
 			chunk#write_string n;
 			chunk#write_bool o;
-			self#write_type_instance t;
+			self#write_type_instance ~debug t;
 		in
 		match t with
 		| TMono r ->
@@ -406,10 +415,10 @@ class ['a] hxb_writer
 				chunk#write_byte 0
 			| Some t ->
 				chunk#write_byte 1;
-				self#write_type_instance t
+				self#write_type_instance ~debug t
 			end
 		| 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); *)
+			(* debug_msg (Printf.sprintf "[%s] KTypeParameter for %s" (s_type_path current_module.m_path) (s_type_path c.cl_path)); *)
 			self#write_type_parameter_ref c
 		| TInst({cl_kind = KExpr e},[]) ->
 			chunk#write_byte 8;
@@ -428,6 +437,7 @@ class ['a] hxb_writer
 				| TAnon an ->
 					chunk#write_byte 1;
 					self#write_anon_ref an td.t_params
+				(* TODO: do something about TMono? *)
 				| _ ->
 					chunk#write_byte 2;
 					self#write_typedef_ref td;
@@ -453,9 +463,14 @@ class ['a] hxb_writer
 					chunk#write_byte 1;
 					self#write_anon_ref an td.t_params;
 					self#write_types tl
-				| _ ->
+				(* TODO: does this help with anything? *)
+				| TMono _ ->
 					chunk#write_byte 2;
-					self#write_typedef_ref td;
+					self#write_type_instance ~debug (apply_typedef td tl);
+					self#write_types tl
+				| _ ->
+					chunk#write_byte 3;
+					self#write_type_instance ~debug (apply_typedef td tl);
 					self#write_types tl
 			end;
 		| TAbstract(a,tl) ->
@@ -470,15 +485,15 @@ class ['a] hxb_writer
 		| TFun(args,t) ->
 			chunk#write_byte 32;
 			chunk#write_list args write_function_arg;
-			self#write_type_instance t;
+			self#write_type_instance ~debug t;
 		| TLazy r ->
 			chunk#write_byte 33;
-			self#write_type_instance (lazy_type r);
+			self#write_type_instance ~debug (lazy_type r);
 		| TDynamic None ->
 			chunk#write_byte 40
 		| TDynamic (Some t) ->
 			chunk#write_byte 41;
-			self#write_type_instance t;
+			self#write_type_instance ~debug t;
 		| TAnon an when PMap.is_empty an.a_fields ->
 			chunk#write_byte 50;
 			chunk#write_bool true
@@ -847,10 +862,10 @@ class ['a] hxb_writer
 		self#write_pos v.v_pos
 
 	method write_texpr (e : texpr) =
-		let rec loop e =
-			(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;
+		let rec loop ?(debug:bool = false) e =
+			(try self#write_type_instance ~debug e.etype; with _ -> begin
+				prerr_endline (Printf.sprintf "Error while writing type instance for:");
+				(* MessageReporting.display_source_at com e.epos; *)
 			end);
 			self#write_pos e.epos;
 
@@ -1010,7 +1025,7 @@ class ['a] hxb_writer
 				self#write_enum_field_ref ef;
 				chunk#write_i32 i;
 			| TEnumParameter(e1,({ ef_type = eft}),i) ->
-				Printf.eprintf "en = %s\n" (s_type_kind eft);
+				prerr_endline (Printf.sprintf "en = %s" (s_type_kind eft));
 				assert false
 			| TField(e1,FInstance(c,tl,cf)) ->
 				chunk#write_byte 102;
@@ -1074,6 +1089,7 @@ class ['a] hxb_writer
 				let infos = t_infos md in
 				let m = infos.mt_module in
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd infos.mt_path);
+				chunk#write_string m.m_extra.m_sign;
 			| TNew(({cl_kind = KTypeParameter _} as c),tl,el) ->
 				chunk#write_byte 127;
 				self#write_type_parameter_ref c;
@@ -1182,19 +1198,19 @@ class ['a] hxb_writer
 	method write_class_field_data cf =
 		let restore = self#start_temporary_chunk in
 		(* if (snd current_module.m_path) = "Main" then *)
-		(* 	Printf.eprintf " (1) Write class field %s\n" cf.cf_name; *)
+		(* 	debug_msg (Printf.sprintf " (1) Write class field %s" cf.cf_name); *)
 		(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
+			prerr_endline (Printf.sprintf "%s while writing type instance for field %s" todo_error cf.cf_name);
+			(* raise e *)
 		end);
 		chunk#write_i32 cf.cf_flags;
 		chunk#write_option cf.cf_doc self#write_documentation;
 		self#write_metadata cf.cf_meta;
 		self#write_field_kind cf.cf_kind;
 		(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
+			prerr_endline (Printf.sprintf "%s while writing expr for field %s" 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_list cf.cf_overloads (fun f -> self#write_class_field_data f);
@@ -1216,7 +1232,7 @@ class ['a] hxb_writer
 	(* Module types *)
 
 	method select_type (path : path) =
-		(* Printf.eprintf "Select type %s\n" (s_type_path path); *)
+		(* debug_msg (Printf.sprintf "Select type %s" (s_type_path path)); *)
 		type_type_parameters <- type_param_lut#extract path
 
 	method write_common_module_type (infos : tinfos) : unit =
@@ -1260,13 +1276,13 @@ class ['a] hxb_writer
 	method write_class (c : tclass) =
 		begin match c.cl_kind with
 		| KAbstractImpl a ->
-			(* Printf.eprintf "Write abstract impl %s with %d type params\n" (snd c.cl_path) (List.length a.a_params); *)
+			(* debug_msg (Printf.sprintf "Write abstract impl %s with %d type params" (snd c.cl_path) (List.length a.a_params)); *)
 			self#select_type a.a_path
 		| _ ->
 			self#select_type c.cl_path;
 		end;
 		(* 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); *)
+		(* debug_msg (Printf.sprintf "[%s] Write class %s with %d type params" (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_class_kind c.cl_kind;
 		chunk#write_u32 (Int32.of_int c.cl_flags);
@@ -1285,7 +1301,7 @@ class ['a] hxb_writer
 		begin try
 			self#select_type a.a_path
 		with Not_found ->
-			print_endline ("Could not select abstract " ^ (s_type_path a.a_path));
+			prerr_endline ("Could not select abstract " ^ (s_type_path a.a_path));
 		end;
 		self#write_common_module_type (Obj.magic a);
 		(* ops *)
@@ -1323,14 +1339,14 @@ class ['a] hxb_writer
 		chunk#write_bool a.a_enum
 
 	method write_enum (e : tenum) =
-		(* Printf.eprintf "Write enum %s\n" (snd e.e_path); *)
+		(* debug_msg (Printf.sprintf "Write enum %s" (snd e.e_path)); *)
 		self#select_type e.e_path;
 		self#write_common_module_type (Obj.magic e);
 		chunk#write_bool e.e_extern;
 		chunk#write_list e.e_names chunk#write_string;
 
 	method write_typedef (td : tdef) =
-		(* Printf.eprintf "Write typedef %s %s >>\n" (s_type_path td.t_path) (s_type_kind td.t_type); *)
+		(* debug_msg (Printf.sprintf "Write typedef %s %s >>" (s_type_path td.t_path) (s_type_kind td.t_type)); *)
 		self#select_type td.t_path;
 		self#write_common_module_type (Obj.magic td);
 		self#write_type_instance td.t_type;
@@ -1399,7 +1415,7 @@ class ['a] hxb_writer
 		in
 
 		let infos = t_infos mt in
-		(* Printf.eprintf "Forward declare type %s\n" (s_type_path infos.mt_path); *)
+		(* debug_msg (Printf.sprintf "Forward declare type %s" (s_type_path infos.mt_path)); *)
 		chunk#write_byte i;
 		(* self#write_path infos.mt_path; *)
 		self#write_full_path (fst infos.mt_path) (snd infos.mt_path) !name;
@@ -1428,7 +1444,7 @@ class ['a] hxb_writer
 			| _ -> assert false);
 
 			chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
-				(* Printf.eprintf "  forward declare enum field %s.%s\n" (s_type_path e.e_path) s; *)
+				(* debug_msg (Printf.sprintf "  forward declare enum field %s.%s" (s_type_path e.e_path) s); *)
 				chunk#write_string s;
 				self#write_pos ef.ef_pos;
 				self#write_pos ef.ef_name_pos;
@@ -1448,8 +1464,8 @@ class ['a] hxb_writer
 		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" *)
-		(* 	(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); *)
+		(* debug_msg (Printf.sprintf "Write module %s with %d own classes, %d own abstracts, %d own enums, %d own typedefs" *)
+		(* 	(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)); *)
 
 		begin match own_abstracts#to_list with
 		| [] ->
@@ -1496,7 +1512,7 @@ class ['a] hxb_writer
 			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) ->
 					self#select_type e.e_path;
-					(* Printf.eprintf "  Write enum field %s.%s\n" (s_type_path e.e_path) s; *)
+					(* debug_msg (Printf.sprintf "  Write enum field %s.%s" (s_type_path e.e_path) s); *)
 					chunk#write_string s;
 					self#set_field_type_parameters ef.ef_params;
 					chunk#write_list ef.ef_params self#write_type_parameter_forward;
@@ -1545,8 +1561,9 @@ class ['a] hxb_writer
 			self#start_chunk CLSR;
 			chunk#write_list l (fun c ->
 				let m = c.cl_module in
-				(* Printf.eprintf "  [cls] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd c.cl_path)])); *)
-				self#write_full_path (fst m.m_path) (snd m.m_path) (snd c.cl_path)
+				(* debug_msg (Printf.sprintf "  [cls] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd c.cl_path)]))); *)
+				self#write_full_path (fst m.m_path) (snd m.m_path) (snd c.cl_path);
+				chunk#write_string m.m_extra.m_sign
 			)
 		end;
 		begin match abstracts#to_list with
@@ -1556,8 +1573,9 @@ class ['a] hxb_writer
 			self#start_chunk ABSR;
 			chunk#write_list l (fun a ->
 				let m = a.a_module in
-				(* Printf.eprintf "  [abs] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd a.a_path)])); *)
-				self#write_full_path (fst m.m_path) (snd m.m_path) (snd a.a_path)
+				(* debug_msg (Printf.sprintf "  [abs] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd a.a_path)]))); *)
+				self#write_full_path (fst m.m_path) (snd m.m_path) (snd a.a_path);
+				chunk#write_string m.m_extra.m_sign
 			)
 		end;
 		begin match enums#to_list with
@@ -1567,8 +1585,9 @@ class ['a] hxb_writer
 			self#start_chunk ENMR;
 			chunk#write_list l (fun en ->
 				let m = en.e_module in
-				(* Printf.eprintf "  [enm] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd en.e_path)])); *)
-				self#write_full_path (fst m.m_path) (snd m.m_path) (snd en.e_path)
+				(* debug_msg (Printf.sprintf "  [enm] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd en.e_path)]))); *)
+				self#write_full_path (fst m.m_path) (snd m.m_path) (snd en.e_path);
+				chunk#write_string m.m_extra.m_sign
 			)
 		end;
 		begin match typedefs#to_list with
@@ -1578,8 +1597,9 @@ class ['a] hxb_writer
 			self#start_chunk TPDR;
 			chunk#write_list l (fun td ->
 				let m = td.t_module in
-				(* Printf.eprintf "  [tpdr] Write full path %s\n" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd td.t_path)])); *)
-				self#write_full_path (fst m.m_path) (snd m.m_path) (snd td.t_path)
+				(* debug_msg (Printf.sprintf "  [tpdr] Write full path %s" (ExtString.String.join "." ((fst m.m_path) @ [(snd m.m_path); (snd td.t_path)]))); *)
+				self#write_full_path (fst m.m_path) (snd m.m_path) (snd td.t_path);
+				chunk#write_string m.m_extra.m_sign
 			)
 		end;
 		self#start_chunk HHDR;

src/compiler/server.ml

@@ -434,7 +434,7 @@ let type_module sctx (ctx:Typecore.typer) mpath p =
 		begin match check_module sctx ctx m p with
 		| None -> ()
 		| Some reason ->
-			ServerMessage.skipping_dep com "" (m,(Printer.s_module_skip_reason reason));
+			ServerMessage.skipping_dep com "" (mpath,(Printer.s_module_skip_reason reason));
 			tcheck();
 			raise Not_found;
 		end;

src/compiler/serverMessage.ml

@@ -100,8 +100,8 @@ let retyper_fail com tabs m reason =
 		print_endline (Printf.sprintf "%s%s%s" (sign_string com) (tabs ^ "  ") reason);
 	end
 
-let skipping_dep com tabs (m,reason) =
-	if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path m.m_path) reason)
+let skipping_dep com tabs (mpath,reason) =
+	if config.print_skipping_dep then print_endline (Printf.sprintf "%sskipping %s (%s)" (sign_string com) (s_type_path mpath) reason)
 
 let unchanged_content com tabs file =
 	if config.print_unchanged_content then print_endline (Printf.sprintf "%s%s changed time not but content, reusing" (sign_string com) file)

src/core/tUnification.ml

@@ -568,7 +568,8 @@ let rec type_eq uctx a b =
 			PMap.iter (fun n f1 ->
 				try
 					let f2 = PMap.find n a2.a_fields in
-					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
+					(* if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind]; *)
+					if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || param = EqDoNotFollowNull || not (unify_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind];
 					let a = f1.cf_type and b = f2.cf_type in
 					(try type_eq uctx a b with Unify_error l -> error (invalid_field n :: l));
 					if (has_class_field_flag f1 CfPublic) != (has_class_field_flag f2 CfPublic) then error [invalid_visibility n];

src/typing/tanon_identification.ml

@@ -59,7 +59,7 @@ object(self)
 		DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm;
 		Hashtbl.replace pfms path pfm
 
-	method unify (tc : Type.t) (pfm : 'a path_field_mapping) =
+	method unify ?(unify_kind = TUnification.unify_kind) ?(strict:bool = false) (tc : Type.t) (pfm : 'a path_field_mapping) =
 		let check () =
 			let pair_up fields =
 				PMap.fold (fun cf acc ->
@@ -85,7 +85,16 @@ object(self)
 					List.iter (fun (cf,cf') ->
 						if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]);
 						fields := PMap.remove cf.cf_name !fields;
-						Type.type_eq EqDoNotFollowNull cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type))
+						(* if strict && cf'.cf_type <> cf.cf_type then raise (Unify_error [Unify_custom "type strict equality failed"]); *)
+						let eq_kind = if strict then {
+							allow_transitive_cast = false;
+							allow_abstract_cast = false;
+							allow_dynamic_to_cast = false;
+							(* equality_kind = EqStrict; *)
+							equality_kind = EqDoNotFollowNull;
+							equality_underlying = true; (* ?? *)
+						} else {default_unification_context with equality_kind = EqDoNotFollowNull} in
+						type_eq_custom eq_kind cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type))
 					) pairs;
 					if not (PMap.is_empty !fields) then raise (Unify_error [Unify_custom "not enough fields"]);
 					monos
@@ -110,12 +119,17 @@ object(self)
 			raise Not_found;
 		let d = DynArray.get pfm_by_arity arity in
 		let l = DynArray.length d in
+		let unify_kind cfk1 cfk2 = cfk1 = cfk2 || match cfk1, cfk2 with
+			| Var _, Var _ | Method _, Method _ -> unify_kind cfk1 cfk2
+			| _ -> false
+		in
+
 		let rec loop i =
 			if i >= l then
 				raise Not_found;
 			let pfm = DynArray.unsafe_get d i in
 			try
-				self#unify tc pfm;
+				self#unify ~unify_kind ~strict:true tc pfm;
 				pfm
 			with Unify_error _ ->
 				loop (i + 1)
@@ -174,4 +188,4 @@ object(self)
 			end;
 		| _ ->
 			None
-end
+end

src/typing/typeloadModule.ml

@@ -793,9 +793,13 @@ let type_module ctx mpath file ?(dont_check_path=false) ?(is_extern=false) tdecl
 
 let type_module_hook = ref (fun _ _ _ -> None)
 
-let rec get_reader ctx input mpath p =
+let rec get_reader ctx g p =
+	(* TODO: create typer context for this module? *)
+	(* let ctx = create_typer_context_for_module tctx m in *)
+
 	let make_module path file =
 		let m = ModuleLevel.make_module ctx path file p in
+		(* m.m_extra.m_added <- ctx.com.compilation_step; *)
 		m.m_extra.m_processed <- 1;
 		m
 	in
@@ -804,14 +808,18 @@ let rec get_reader ctx input mpath p =
 		ctx.com.module_lut#add m.m_path m
 	in
 
-	let resolve_type pack mname tname =
-		let m = try ctx.com.module_lut#find (pack,mname) with Not_found -> load_module' ctx ctx.g (pack,mname) p in
+	let flush_fields () =
+		flush_pass ctx PConnectField "hxb"
+	in
+
+	let resolve_type sign pack mname tname =
+		let m = load_module' ctx g (pack,mname) p in
 		List.find (fun t -> snd (t_path t) = tname) m.m_types
 	in
 
-	new HxbReader.hxb_reader ctx.com input make_module add_module resolve_type
+	new HxbReader.hxb_reader make_module add_module resolve_type flush_fields
 
-and load_hxb_module ctx path p =
+and load_hxb_module ctx g path p =
 	let compose_path no_rename =
 		(match path with
 		| [] , name -> name
@@ -830,7 +838,7 @@ and load_hxb_module ctx path p =
 	(* TODO use finally instead *)
 	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 g p)#read input true p in
 		(* Printf.eprintf "[%s] Done reading module %s\n" target (s_type_path path); *)
 		close_in ch;
 		m
@@ -851,7 +859,7 @@ and load_module' ctx g m p =
 		| Some m ->
 			m
 		(* Try loading from hxb first, then from source *)
-		| None -> try load_hxb_module ctx m p with Not_found ->
+		| None -> try load_hxb_module ctx g m p with Not_found ->
 			let raise_not_found () = raise_error_msg (Module_not_found m) p in
 			if ctx.com.module_nonexistent_lut#mem m then raise_not_found();
 			if ctx.g.load_only_cached_modules then raise_not_found();