瀏覽代碼

[hxb] anons / anon fields mostly working

Still need to make sure all needed references are gathered before
Rudy Ges 2 年之前
父節點
當前提交
739ebdc22c
共有 4 個文件被更改,包括 262 次插入138 次删除
  1. 12 0
      src/compiler/hxb/hxbData.ml
  2. 144 75
      src/compiler/hxb/hxbReader.ml
  3. 104 63
      src/compiler/hxb/hxbWriter.ml
  4. 2 0
      src/core/tFunctions.ml

+ 12 - 0
src/compiler/hxb/hxbData.ml

@@ -4,17 +4,21 @@ type chunk_kind =
 	| STRI (* string pool *)
 	| DOCS (* doc pool *)
 	| HHDR (* module header *)
+	| ANNR (* anon reference array *)
 	| TYPF (* forward types *)
 	| CLSR (* class reference array *)
 	| ABSR (* abstract reference array *)
 	| TPDR (* typedef reference array *)
 	| ENMR (* enum reference array *)
+	| ANFR (* anon field reference array *)
 	| CLSD (* class definition *)
 	| ABSD (* abstract definition *)
 	| CFLD (* class fields *)
 	| TPDD (* typedef definition *)
 	| ENMD (* enum definition *)
 	| EFLD (* enum fields *)
+	| ANND (* anon definition *)
+	| ANFD (* anon fields *)
 	| HEND (* the end *)
 
 let string_of_chunk_kind = function
@@ -22,16 +26,20 @@ let string_of_chunk_kind = function
 	| DOCS -> "DOCS"
 	| HHDR -> "HHDR"
 	| TYPF -> "TYPF"
+	| ANNR -> "ANNR"
 	| CLSR -> "CLSR"
 	| ABSR -> "ABSR"
 	| ENMR -> "ENMR"
 	| TPDR -> "TPDR"
+	| ANFR -> "ANFR"
+	| ANND -> "ANND"
 	| CLSD -> "CLSD"
 	| CFLD -> "CFLD"
 	| ABSD -> "ABSD"
 	| ENMD -> "ENMD"
 	| EFLD -> "EFLD"
 	| TPDD -> "TPDD"
+	| ANFD -> "ANFD"
 	| HEND -> "HEND"
 
 let chunk_kind_of_string = function
@@ -39,15 +47,19 @@ let chunk_kind_of_string = function
 	| "DOCS" -> DOCS
 	| "HHDR" -> HHDR
 	| "TYPF" -> TYPF
+	| "ANNR" -> ANNR
 	| "CLSR" -> CLSR
 	| "ABSR" -> ABSR
 	| "ENMR" -> ENMR
 	| "TPDR" -> TPDR
+	| "ANFR" -> ANFR
+	| "ANND" -> ANND
 	| "CLSD" -> CLSD
 	| "CFLD" -> CFLD
 	| "ABSD" -> ABSD
 	| "ENMD" -> ENMD
 	| "EFLD" -> EFLD
+	| "ANFD" -> ANFD
 	| "TPDD" -> TPDD
 	| "HEND" -> HEND
 	| name -> raise (HxbFailure ("Invalid chunk name: " ^ name))

+ 144 - 75
src/compiler/hxb/hxbReader.ml

@@ -27,11 +27,17 @@ class hxb_reader
 	val mutable abstracts = Array.make 0 null_abstract
 	val mutable enums = Array.make 0 null_enum
 	val mutable typedefs = Array.make 0 null_typedef
+	val mutable anons = Array.make 0 null_tanon
+	val mutable anon_fields = Array.make 0 null_field
 
 	val vars = Hashtbl.create 0
 	val mutable type_type_parameters = Array.make 0 (mk_type_param "" t_dynamic None)
 	val mutable field_type_parameters = Array.make 0 (mk_type_param "" t_dynamic None)
 
+	(* method ctrl () = *)
+	(* 	let s = self#read_string in *)
+	(* 	if s <> "ctrl" then assert false *)
+
 	(* Primitives *)
 
 	method read_u8 =
@@ -165,6 +171,11 @@ class hxb_reader
 		let i = self#read_uleb128 in
 		typedefs.(i)
 
+	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)
+
 	(* method read_field_ref fields = *)
 	method read_field_ref source fields =
 		let name = self#read_string in
@@ -180,28 +191,40 @@ class hxb_reader
 			Printf.eprintf "    Available fields: %s\n" (PMap.fold (fun ef acc -> acc ^ " " ^ ef.ef_name) en.e_constrs "");
 			null_enum_field
 
+	method read_anon_field_ref =
+		let i = self#read_uleb128 in
+		anon_fields.(i)
+
 	(* Type instances *)
 
 	method read_type_instance =
-		match self#read_u8 with
+		let kind = self#read_u8 in
+		Printf.eprintf "   Read type instance %d\n" kind;
+
+		match kind with
 		| 0 ->
-			Printf.eprintf "  %s identity\n" todo;
+			(* Printf.eprintf "  %s identity\n" todo; *)
 			mk_mono() (* TODO: identity *)
 		| 1 ->
-			self#read_type_instance
+			(* Printf.eprintf "  %s TMono Some\n" todo; *)
+			let t = self#read_type_instance in
+			let tmono = !monomorph_create_ref () in (* TODO identity *)
+			tmono.tm_type <- Some t;
+			TMono tmono;
 		| 5 ->
 			let i = self#read_uleb128 in
-			(* Printf.eprintf "     Get field type param %d\n" i; *)
+			Printf.eprintf "     Get field type param %d\n" i;
 			(field_type_parameters.(i)).ttp_type
 		| 6 ->
 			let i = self#read_uleb128 in
-			(* Printf.eprintf "     Get type type param %d\n" i; *)
+			Printf.eprintf "     Get type type param %d\n" i;
 			(type_type_parameters.(i)).ttp_type
 		| 10 ->
 			TInst(self#read_class_ref,[])
 		| 11 ->
 			TEnum(self#read_enum_ref,[])
 		| 12 ->
+			(* TODO check if this is still correct *)
 			begin match self#read_u8 with
 				| 0 ->
 					let c = self#read_class_ref in
@@ -245,16 +268,21 @@ class hxb_reader
 			(* Printf.eprintf "  Read type instance for TFun\n"; *)
 			let ret = self#read_type_instance in
 			TFun(args,ret)
+		| 33 -> (* TODO other number *)
+			let t = self#read_type_instance in
+			TLazy (ref (LAvailable t))
 		| 40 ->
 			t_dynamic
 		| 41 ->
 			TDynamic (Some self#read_type_instance)
 		| 50 ->
-			mk_anon (ref Closed)
+			Printf.eprintf "  Read TAnon type instance 50\n";
+			let empty = self#read_bool in
+			if empty then mk_anon (ref Closed)
+			else TAnon self#read_anon_ref
 		| 51 ->
-			ignore(self#read_uleb128);
-			Printf.eprintf "  %s TAnon\n" todo;
-			t_dynamic (* TODO *)
+			Printf.eprintf "  Read TAnon type instance 51\n";
+			TAnon self#read_anon_ref
 		| i ->
 			error (Printf.sprintf "Bad type instance id: %i" i)
 
@@ -326,29 +354,6 @@ class hxb_reader
 		| i ->
 			error (Printf.sprintf "Bad field kind: %i" i)
 
-	(* method read_type_parameter = *)
-	(* 	let name = self#read_string in *)
-	(* 	let c = self#read_class true in *)
-	(* 	(name,TInst(c,[])) *)
-
-	(* method read_quote_status = *)
-	(* 	match IO.read_byte ch with *)
-	(* 	| 0 -> NoQuotes *)
-	(* 	| 1 -> DoubleQuotes *)
-	(* 	| _ -> assert false *)
-
-	(* method read_object_field_key = *)
-	(* 	let name = self#read_string in *)
-	(* 	let p = self#read_pos in *)
-	(* 	let quotes = self#read_quote_status in *)
-	(* 	(name,p,quotes) *)
-
-	(* method read_object_field = *)
-	(* 	Printf.eprintf "   read_object_field\n"; *)
-	(* 	let k = self#read_object_field_key in *)
-	(* 	let e = self#read_texpr in *)
-	(* 	(k,e) *)
-
 	method read_tfunction_arg =
 		let v = self#read_var in
 		let cto = self#read_option (fun () -> self#read_texpr) in
@@ -558,10 +563,8 @@ class hxb_reader
 				TField(e1,FStatic(c,cf))
 			| 104 ->
 				let e1 = self#read_texpr in
-				(* TODO (see writer) *)
-				(* TODO TField(e1,FAnon(cf)) *)
-				Printf.eprintf "  %s TField(e,FAnon(cf))\n" todo;
-				e1.eexpr
+				let cf = self#read_anon_field_ref in
+				TField(e1,FAnon(cf))
 			| 105 ->
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
@@ -572,10 +575,8 @@ class hxb_reader
 				TField(e1,FClosure(Some(c,tl),cf))
 			| 106 ->
 				let e1 = self#read_texpr in
-				(* TODO (see writer) *)
-				(* TODO TField(e1,FClosure(None,cf)) *)
-				Printf.eprintf "  %s TField(e,FClosure(None,cf))\n" todo;
-				e1.eexpr
+				let cf = self#read_anon_field_ref in
+				TField(e1,FClosure(None,cf))
 			| 107 ->
 				let e1 = self#read_texpr in
 				let en = self#read_enum_ref in
@@ -685,22 +686,28 @@ class hxb_reader
 
 	method read_class_field (m : module_def) (cf : tclass_field) : unit =
 		let name = cf.cf_name in
-		(* Printf.eprintf "  field type parameters for %s\n" name; *)
+		Printf.eprintf "  Read class field %s\n" name;
 		self#read_type_parameters m ([],name) (fun a ->
 			field_type_parameters <- a
 		);
 		let params = Array.to_list field_type_parameters in
+		(* Printf.eprintf "  Read class field %s - read type instance\n" name; *)
 		let t = self#read_type_instance in
+
+		(* Printf.eprintf "  Read class field %s - read flags\n" name; *)
 		let flags = IO.read_i32 ch in
 
+		(* Printf.eprintf "  Read class field %s - read doc/meta/kind\n" name; *)
 		let doc = self#read_option (fun () -> self#read_documentation) in
 		let meta = self#read_metadata in
 		let kind = self#read_field_kind in
 
+		(* Printf.eprintf "  Read class field %s - read expr\n" name; *)
 		let expr = self#read_option (fun () -> self#read_texpr) in
 		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
 		let overloads = self#read_list16 (fun () -> self#read_class_field' m) in
 
+		(* Printf.eprintf "  Read class field %s - done\n" name; *)
 		cf.cf_type <- t;
 		cf.cf_doc <- doc;
 		cf.cf_meta <- meta;
@@ -713,23 +720,30 @@ class hxb_reader
 
 	method read_class_field' (m : module_def) : tclass_field =
 		let name = self#read_string in
-		(* Printf.eprintf "  field type parameters for %s\n" name; *)
+		Printf.eprintf "  Read class field %s\n" name;
 		self#read_type_parameters m ([],name) (fun a ->
 			field_type_parameters <- a
 		);
 		let params = Array.to_list field_type_parameters in
+		(* Printf.eprintf "  Read class field %s - read type instance\n" name; *)
 		let t = self#read_type_instance in
+		(* Printf.eprintf "  Read class field %s - read flags\n" name; *)
 		let flags = IO.read_i32 ch in
+		(* Printf.eprintf "  Read class field %s - read pos/name pos\n" name; *)
 		let pos = self#read_pos in
 		let name_pos = self#read_pos in
 
+		(* Printf.eprintf "  Read class field %s - read doc/meta/kind\n" name; *)
 		let doc = self#read_option (fun () -> self#read_documentation) in
 		let meta = self#read_metadata in
 		let kind = self#read_field_kind in
 
+		(* Printf.eprintf "  Read class field %s - read expr\n" name; *)
 		let expr = self#read_option (fun () -> self#read_texpr) in
 		let expr_unoptimized = self#read_option (fun () -> self#read_texpr) in
 		let overloads = self#read_list16 (fun () -> self#read_class_field' m) in
+
+		(* Printf.eprintf "  Read class field %s - done\n" name; *)
 		{
 			cf_name = name;
 			cf_type = t;
@@ -872,6 +886,8 @@ class hxb_reader
 			(* let cf = self#read_field_ref impl.cl_fields in *)
 			(t,cf)
 		);
+
+		(* TODO check if those work, then remove debug arg *)
 		a.a_array <- self#read_list16 (fun () -> self#read_field_ref "TODO" (Option.get a.a_impl).cl_statics);
 		a.a_read <- self#read_option (fun () -> self#read_field_ref "TODO" (Option.get a.a_impl).cl_fields);
 		a.a_write <- self#read_option (fun () -> self#read_field_ref "TODO" (Option.get a.a_impl).cl_fields);
@@ -881,20 +897,24 @@ class hxb_reader
 	method read_enum (m : module_def) (e : tenum) =
 		Printf.eprintf "  Read enum %s\n" (s_type_path e.e_path);
 		self#read_common_module_type m (Obj.magic e);
-		(* e.e_type <- self#read_typedef_ref; *)
-		let td_path = self#read_path in
-		let td_pos = self#read_pos in
-		let td_name_pos = self#read_pos in
-		let td = mk_typedef m td_path td_pos td_name_pos (mk_mono()) in
-		self#read_typedef m td;
-		e.e_type <- td;
 		e.e_extern <- self#read_bool;
-		e.e_names <- self#read_list16 (fun () -> self#read_string)
+		e.e_names <- self#read_list16 (fun () -> self#read_string);
 
 	method read_typedef (m : module_def) (td : tdef) =
-		Printf.eprintf "  Read typedef %s\n" (s_type_path td.t_path);
+		Printf.eprintf "  Reading typedef %s\n" (s_type_path td.t_path);
 		self#read_common_module_type m (Obj.magic td);
-		td.t_type <- self#read_type_instance
+		td.t_type <- self#read_type_instance;
+
+		(* TODO this is so unsafe... *)
+		match td.t_type with
+		| TMono { tm_type = Some (TLazy r) }
+		| TLazy r ->
+			begin match lazy_type r with
+				| TAnon an ->
+					ignore(self#read_list16 (fun () -> self#read_type_instance));
+				| _ -> ()
+			end
+		| _ -> ();
 
 	(* Chunks *)
 
@@ -911,6 +931,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); *)
 		let kind = chunk_kind_of_string name in
 		(kind,data)
 
@@ -949,6 +970,55 @@ class hxb_reader
 			self#read_enum_fields m e;
 		done
 
+	method read_annd (m : module_def) =
+		let l = self#read_uleb128 in
+		for i = 0 to l - 1 do
+			let tname = self#read_string in
+			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;
+
+			let an = anons.(i) in
+			let read_fields () =
+				let fields = self#read_list16 (fun () -> self#read_class_field' m) in
+				List.iter (fun cf -> ignore(PMap.add cf.cf_name cf an.a_fields)) fields
+			in
+
+			begin match self#read_u8 with
+			| 0 ->
+				an.a_status := Closed;
+				read_fields ()
+			| 1 ->
+				an.a_status := Const;
+				read_fields ()
+			| 2 ->
+				an.a_status := Extend self#read_types;
+				read_fields ()
+			| 3 ->
+				an.a_status := Statics self#read_class_ref;
+			| 4 ->
+				an.a_status := EnumStatics self#read_enum_ref;
+				read_fields ()
+			| 5 ->
+				an.a_status := AbstractStatics self#read_abstract_ref;
+				read_fields ()
+			| _ -> assert false
+			end;
+		done
+
+	method read_anfd (m : module_def) =
+		let l = self#read_uleb128 in
+		for i = 0 to l - 1 do
+			let cf = anon_fields.(i) in
+			let _ = self#read_string in
+			self#read_class_field m cf;
+		done
 
 	method read_tpdd (m : module_def) =
 		let l = self#read_uleb128 in
@@ -959,13 +1029,9 @@ class hxb_reader
 
 	method read_clsr =
 		let l = self#read_uleb128 in
-		(* Note: this shouldn't be necessary; trying to fix something with typedef ref *)
-		(* classes <- Array.append classes (Array.init l (fun i -> *)
-		(* let own = Array.length classes in *)
 		classes <- (Array.init l (fun i ->
 				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));
-				(* if i < own then classes.(i) else *)
 				match resolve_type pack mname tname with
 				| 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);
@@ -973,23 +1039,12 @@ class hxb_reader
 				| _ ->
 					error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
 		))
-		(* classes <- self#read_list16 (fun () -> *)
-		(* 	let (pack,mname,tname) = self#read_full_path in *)
-		(* 	match resolve_type pack mname tname with *)
-		(* 	| TClassDecl c -> *)
-		(* 		c *)
-		(* 	| _ -> *)
-		(* 		error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname))) *)
-		(* ); *)
 
 	method read_absr =
 		let l = self#read_uleb128 in
-		(* let own = Array.length abstracts in *)
 		abstracts <- (Array.init l (fun i ->
-		(* abstracts <- Array.append abstracts (Array.init l (fun i -> *)
 			let (pack,mname,tname) = self#read_full_path in
 			Printf.eprintf "  Read absr %d of %d for abstract %s\n" i l tname;
-			(* if i < own then abstracts.(i) else *)
 			match resolve_type pack mname tname with
 			| TAbstractDecl a ->
 				a
@@ -999,13 +1054,9 @@ class hxb_reader
 
 	method read_enmr =
 		let l = self#read_uleb128 in
-		(* let own = Array.length enums in *)
 		enums <- (Array.init l (fun i ->
-		(* enums <- Array.append enums (Array.init l (fun i -> *)
-		(* enums <- (Array.init l (fun i -> *)
 			let (pack,mname,tname) = self#read_full_path in
 			Printf.eprintf "  Read enmr %d of %d for enum %s\n" i l tname;
-			(* if i < own then enums.(i) else *)
 			match resolve_type pack mname tname with
 			| TEnumDecl en ->
 				en
@@ -1015,13 +1066,9 @@ class hxb_reader
 
 	method read_tpdr =
 		let l = self#read_uleb128 in
-		(* let own = Array.length typedefs in *)
 		typedefs <- (Array.init l (fun i ->
-		(* typedefs <- Array.append typedefs (Array.init l (fun i -> *)
-		(* typedefs <- (Array.init l (fun i -> *)
 			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));
-			(* if i < own then typedefs.(i) else *)
 			match resolve_type pack mname tname with
 			| TTypeDecl tpd ->
 				tpd
@@ -1029,6 +1076,20 @@ class hxb_reader
 				error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname)))
 		))
 
+	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_anfr =
+		let l = self#read_uleb128 in
+		anon_fields <- (Array.init l (fun i ->
+			let name = self#read_string in
+			let pos = self#read_pos in
+			let name_pos = self#read_pos in
+			{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos }
+		))
+
 	method read_typf (m : module_def) =
 		self#read_list16 (fun () ->
 			let kind = self#read_u8 in
@@ -1159,6 +1220,10 @@ class hxb_reader
 				self#read_enmr;
 			| TPDR ->
 				self#read_tpdr;
+			| ANNR ->
+				self#read_annr;
+			| ANFR ->
+				self#read_anfr;
 			| ABSD ->
 				self#read_absd m;
 			| CLSD ->
@@ -1169,6 +1234,10 @@ class hxb_reader
 				self#read_enmd m;
 			| EFLD ->
 				self#read_efld m;
+			| ANND ->
+				self#read_annd m;
+			| ANFD ->
+				self#read_anfd m;
 			| TPDD ->
 				self#read_tpdd m;
 			| _ ->

+ 104 - 63
src/compiler/hxb/hxbWriter.ml

@@ -71,6 +71,9 @@ class ['key,'value] pool = object(self)
 	method extract (key : 'key) =
 		DynArray.get items (self#get key)
 
+	method has (key : 'key) =
+		Hashtbl.mem lut key
+
 	method get (key : 'key) =
 		Hashtbl.find lut key
 
@@ -214,21 +217,22 @@ class ['a] hxb_writer
 	val enums = new pool
 	val typedefs = new pool
 	val abstracts = new pool
-
-	(* val fields = new pool *)
+	val anons = new pool
+	val anon_fields = new pool
 
 	val own_classes = new pool
 	val own_abstracts = new pool
 	val own_enums = new pool
 	val own_typedefs = new pool
 
-	(* TODO *)
-	val anons = new pool
-
 	val type_param_lut = new pool
+	val mutable ttp_key = ([],"")
 	val mutable type_type_parameters = new pool
 	val mutable field_type_parameters = new pool
 
+	(* method ctrl () = *)
+	(* 	chunk#write_string "ctrl" *)
+
 	(* Chunks *)
 
 	method start_chunk (kind : chunk_kind) =
@@ -296,6 +300,12 @@ class ['a] hxb_writer
 		(* Printf.eprintf "  Write abstract ref %d for %s\n" i (snd a.a_path); *)
 		chunk#write_uleb128 i
 
+	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
+		Printf.eprintf "  Write anon ref %d for %s\n" i (s_type_path pfm.pfm_path);
+		chunk#write_uleb128 i
+
 	method write_field_ref (source : field_source) (cf : tclass_field) =
 		chunk#write_string cf.cf_name
 
@@ -311,6 +321,7 @@ class ['a] hxb_writer
 			self#write_type_instance t;
 		in
 		match t with
+		(* TODO: we might need to properly restore monomorphs... *)
 		| TMono r ->
 			begin match r.tm_type with
 			| None ->
@@ -389,6 +400,7 @@ class ['a] hxb_writer
 			chunk#write_list args write_function_arg;
 			self#write_type_instance t;
 		| TLazy r ->
+			chunk#write_byte 33;
 			self#write_type_instance (lazy_type r);
 		| TDynamic None ->
 			chunk#write_byte 40
@@ -397,31 +409,10 @@ class ['a] hxb_writer
 			self#write_type_instance t;
 		| TAnon an when PMap.is_empty an.a_fields ->
 			chunk#write_byte 50;
+			chunk#write_bool true
 		| TAnon an ->
-			let pfm = Option.get (anon_id#identify true t) in
 			chunk#write_byte 51;
-			chunk#write_uleb128 (anons#get_or_add pfm.pfm_path an);
-			Printf.eprintf "  %s TAnon an\n" todo;
-			(* TODO TAnon *)
-			(* begin match !(an.a_status) with
-			| Closed -> chunk#write_byte 50
-			| Const -> chunk#write_byte 51
-			| Extend _ -> chunk#write_byte 52
-			| Statics _ -> chunk#write_byte 53
-			| EnumStatics _ -> chunk#write_byte 54
-			| AbstractStatics _ -> chunk#write_byte 55
-			end; *)
-			(* let l = pmap_to_list an.a_fields in
-			(* chunk#write_list l (fun (_,cf) -> self#write_class_field cf); *)
-			begin match !(an.a_status) with
-			| Extend tl -> self#write_types tl
-			| Statics c -> self#write_class_ref c
-			| EnumStatics en -> self#write_enum_ref en
-			| AbstractStatics a -> self#write_abstract_ref a
-			| Closed
-			| Const ->
-				()
-			end; *)
+			self#write_anon_ref an;
 
 	method write_types tl =
 		chunk#write_list tl self#write_type_instance
@@ -641,9 +632,8 @@ class ['a] hxb_writer
 			| TField(e1,FAnon cf) ->
 				chunk#write_byte 104;
 				loop e1;
-				Printf.eprintf "  %s TField(e,FAnon cf)\n" todo;
-				(* TODO *)
-				(* self#write_field_ref (ClassMember c) cf; (1* TODO check source *1) *)
+				chunk#write_uleb128 (anon_fields#get_or_add cf cf);
+				(* Printf.eprintf "  %s TField(e,FAnon cf)\n" todo; *)
 			| TField(e1,FClosure(Some(c,tl),cf)) ->
 				chunk#write_byte 105;
 				loop e1;
@@ -654,9 +644,8 @@ class ['a] hxb_writer
 			| TField(e1,FClosure(None,cf)) ->
 				chunk#write_byte 106;
 				loop e1;
-				Printf.eprintf "  %s TField(e,FClosure(None,cf))\n" todo;
-				(* TODO *)
-				(* self#write_field_ref (ClassMember c) cf; (1* TODO check source *1) *)
+				chunk#write_uleb128 (anon_fields#get_or_add cf cf);
+				(* Printf.eprintf "  %s TField(e,FClosure(None,cf))\n" todo; *)
 			| TField(e1,FEnum(en,ef)) ->
 				chunk#write_byte 107;
 				loop e1;
@@ -794,6 +783,8 @@ class ['a] hxb_writer
 	(* Module types *)
 
 	method select_type (path : path) =
+		Printf.eprintf "Select type %s\n" (s_type_path path);
+		ttp_key <- path;
 		type_type_parameters <- type_param_lut#extract path
 
 	method write_common_module_type (infos : tinfos) : unit =
@@ -860,15 +851,6 @@ class ['a] hxb_writer
 		);
 		chunk#write_option c.cl_dynamic self#write_type_instance;
 		chunk#write_option c.cl_array_access self#write_type_instance;
-		(* (1* Write minimal data to be able to create refs *1) *)
-		(* let write_field cf = *)
-		(* 	chunk#write_string cf.cf_name; *)
-		(* 	self#write_pos cf.cf_pos; *)
-		(* 	self#write_pos cf.cf_name_pos *)
-		(* in *)
-		(* chunk#write_option c.cl_constructor write_field; *)
-		(* chunk#write_list c.cl_ordered_fields write_field; *)
-		(* chunk#write_list c.cl_ordered_statics write_field; *)
 
 	method write_abstract (a : tabstract) =
 		begin try
@@ -915,22 +897,60 @@ class ['a] hxb_writer
 		Printf.eprintf "Write enum %s\n" (snd e.e_path);
 		self#select_type e.e_path;
 		self#write_common_module_type (Obj.magic e);
-
-		(* Printf.eprintf "  Write typedef ref for %s\n" (snd e.e_type.t_path); *)
-		self#write_path e.e_type.t_path;
-		self#write_pos e.e_type.t_pos;
-		self#write_pos e.e_type.t_name_pos;
-		self#write_common_module_type (Obj.magic e.e_type);
-		self#write_type_instance e.e_type.t_type;
-		(* self#write_typedef_ref e.e_type; *)
-
 		chunk#write_bool e.e_extern;
-		chunk#write_list e.e_names chunk#write_string
+		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);
 		self#select_type td.t_path;
 		self#write_common_module_type (Obj.magic td);
-		self#write_type_instance td.t_type
+		self#write_type_instance td.t_type;
+
+		(* TODO this is so unsafe... *)
+		match td.t_type with
+		| TMono { tm_type = Some (TLazy r) }
+		| TLazy r ->
+			begin match lazy_type r with
+				| TAnon an ->
+					chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) an.a_fields []) (fun (s,cf) ->
+						self#write_type_instance cf.cf_type;
+					);
+				| _ -> ()
+			end
+		| _ -> ();
+
+	method write_anon (m : module_def) ((an : tanon), (ttp_key : path)) =
+		chunk#write_string (snd ttp_key);
+		self#select_type ttp_key;
+
+		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;
+			)
+		in
+
+		begin match !(an.a_status) with
+		| Closed ->
+			chunk#write_byte 0;
+			write_fields ()
+		| Const ->
+			chunk#write_byte 1;
+			write_fields ()
+		| Extend tl ->
+			chunk#write_byte 2;
+			self#write_types tl;
+			write_fields ()
+		| Statics c ->
+			chunk#write_byte 3;
+			self#write_class_ref c;
+		| EnumStatics en ->
+			chunk#write_byte 4;
+			write_fields ()
+		| AbstractStatics a ->
+			chunk#write_byte 5;
+			self#write_abstract_ref a;
+			write_fields ()
+		end
 
 	(* Module *)
 
@@ -1043,7 +1063,7 @@ class ['a] hxb_writer
 			chunk#write_list own_enums self#write_enum;
 			self#start_chunk EFLD;
 			chunk#write_list own_enums (fun e ->
-				(* TODO use to_list *)
+				(* TODO write and use pmap_to_list *)
 				chunk#write_list (PMap.foldi (fun s f acc -> (s,f) :: acc) e.e_constrs []) (fun (s,ef) ->
 					Printf.eprintf "  Write enum field %s.%s\n" (s_type_path e.e_path) s;
 					chunk#write_string s;
@@ -1104,17 +1124,38 @@ class ['a] hxb_writer
 			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)]));
-				(* Printf.eprintf "  [tpdr] Write full path %s\n" (ExtString.String.join "." ((fst td.t_path) @ [(snd td.t_path)])); *)
-				(* match td.t_params with *)
-				(* | [] -> () *)
-				(* | params -> *)
-				(* 	List.iter (fun ttp -> *)
-				(* 		(1* ignore(type_type_parameters#add ttp.ttp_name ttp); *1) *)
-				(* 		Printf.eprintf "   [tpdr] type param %s %s\n" ttp.ttp_name (s_type_kind ttp.ttp_type); *)
-				(* 	) params; *)
 				self#write_full_path (fst m.m_path) (snd m.m_path) (snd td.t_path)
 			)
 		end;
+
+		begin match anons#to_list with
+		| [] ->
+			()
+		| anons ->
+			self#start_chunk ANNR;
+			chunk#write_uleb128 (List.length anons);
+			self#start_chunk ANND;
+			chunk#write_list anons (fun an -> self#write_anon m an);
+		end;
+
+		let anon_fields = anon_fields#to_list in
+		begin match anon_fields with
+		| [] ->
+			()
+		| l ->
+			self#start_chunk ANFR;
+			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;
+			);
+		end;
+
 		self#start_chunk HEND;
 
 	(* Export *)

+ 2 - 0
src/core/tFunctions.ml

@@ -216,6 +216,8 @@ let null_typedef =
 	t.t_private <- true;
 	t
 
+let null_tanon = { a_fields = PMap.empty; a_status = ref Closed }
+
 let null_enum = {
 	e_path = ([],"");
 	e_module = null_module;