WIP - typedef path issue

src/compiler/hxb/hxbData.ml

@@ -9,9 +9,9 @@ type chunk_kind =
 	| ABSR (* abstract reference array *)
 	| ENMR (* enum reference array *)
 	| TPDR (* typedef reference array *)
+	| ABSD (* abstract definition *)
 	| CLSD (* class definition *)
 	| CFLD (* class fields without expressions *)
-	| ABSD (* abstract definition *)
 	| ENMD (* enum definition *)
 	| TPDD (* typedef definition *)
 	| HEND (* the end *)
@@ -50,4 +50,5 @@ let chunk_kind_of_string = function
 	| name -> raise (HxbFailure ("Invalid chunk name: " ^ name))
 
 let error (s : string) =
+	Printf.eprintf "[error] %s\n" s;
 	raise (HxbFailure s)

src/compiler/hxb/hxbReader.ml

@@ -20,9 +20,9 @@ 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 class_fields = Array.make 0 null_class_field
-	val mutable abstract_fields = Array.make 0 null_abstract_field
-	val mutable enum_fields = Array.make 0 null_enum_field
+	(* val mutable class_fields = Array.make 0 null_class_field *)
+	(* val mutable abstract_fields = Array.make 0 null_abstract_field *)
+	(* val mutable enum_fields = Array.make 0 null_enum_field *)
 
 	val vars = Hashtbl.create 0
 	(* val mutable vars = Array.make 0 null_tvar *)
@@ -107,10 +107,10 @@ class hxb_reader
 		(pack,name)
 
 	method read_full_path =
-		let pack = self#read_list8 (fun () -> self#read_string) in
+		let pack = self#read_list16 (fun () -> self#read_string) in
 		let mname = self#read_string in
 		let tname = self#read_string in
-		Printf.eprintf "    Read full path %s.%s.%s\n" (ExtString.String.join "." pack) mname tname;
+		Printf.eprintf "    Read full path %s\n" (ExtString.String.join "." (pack @ [mname; tname]));
 		(pack,mname,tname)
 
 	method read_documentation =
@@ -171,19 +171,19 @@ class hxb_reader
 		enums.(i)
 
 	method read_typedef_ref =
-		typedefs.(self#read_uleb128)
+		let i = self#read_uleb128 in
+		typedefs.(i)
 
-	method read_field_ref =
+	method read_field_ref fields =
 		let name = self#read_string in
-		Printf.eprintf "  TODO: resolve field %s...\n" name;
-		null_field (* TODO *)
+		try PMap.find name fields with e ->
+			Printf.eprintf "  TODO error reading field ref for %s\n" name;
+			(* raise e *)
+			null_field
 
 	method read_enum_field_ref =
 		assert false (* TODO *)
 
-	method read_anon_field_ref =
-		assert false (* TODO *)
-
 	(* Type instances *)
 
 	method read_type_instance =
@@ -198,7 +198,9 @@ class hxb_reader
 			(* Printf.eprintf "     Get field type param %d\n" i; *)
 			(field_type_parameters.(i)).ttp_type
 		| 6 ->
-			(type_type_parameters.(self#read_uleb128)).ttp_type
+			let i = self#read_uleb128 in
+			(* Printf.eprintf "     Get type type param %d\n" i; *)
+			(type_type_parameters.(i)).ttp_type
 		| 10 ->
 			TInst(self#read_class_ref,[])
 		| 11 ->
@@ -215,21 +217,28 @@ class hxb_reader
 			let c = self#read_class_ref in
 			let tl = self#read_types in
 			TInst(c,tl)
-		| 15
-		| 16
+		| 15 ->
+			let e = self#read_enum_ref in
+			let tl = self#read_types in
+			TEnum(e,tl)
+		| 16 ->
+			let t = self#read_typedef_ref in
+			let tl = self#read_types in
+			TType(t,tl)
 		| 17 ->
-			ignore(self#read_uleb128);
-			let _ = self#read_types in
-			Printf.eprintf "  TODO TAbstract\n";
-			t_dynamic (* TODO *)
+			let a = self#read_abstract_ref in
+			let tl = self#read_types in
+			TAbstract(a,tl)
 		| 32 ->
 			let f () =
 				let name = self#read_string in
+				(* Printf.eprintf "  Read type instance for %s\n" name; *)
 				let opt = self#read_bool in
 				let t = self#read_type_instance in
 				(name,opt,t)
 			in
 			let args = self#read_list16 f in
+			(* Printf.eprintf "  Read type instance for TFun\n"; *)
 			let ret = self#read_type_instance in
 			TFun(args,ret)
 		| 40 ->
@@ -255,10 +264,10 @@ 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); *)
+			Printf.eprintf "      Read ttp pos for %s: %s\n" name (Printer.s_pos pos);
+			Printf.eprintf "      - Path was %s\n" (s_type_path path);
 
-			(* This is wrong for field ttp *)
+			(* This is wrong for field ttp (why again?) *)
 			let c = mk_class m (fst path @ [snd path],name) pos pos in
 			mk_type_param name (TInst(c,[])) None
 		) in
@@ -367,31 +376,6 @@ class hxb_reader
 	(* 	let e = self#read_texpr in *)
 	(* 	(v,e) *)
 
-	method read_tfield_access =
-		match IO.read_byte ch with
-		| 0 ->
-			let c = self#read_class_ref in
-			let tl = self#read_types in
-			let cf = self#read_field_ref in
-			FInstance(c,tl,cf)
-		| 1 ->
-			let c = self#read_class_ref in
-			let cf = self#read_field_ref in
-			FStatic(c,cf)
-		| 2 -> FAnon(self#read_anon_field_ref)
-		| 3 -> FDynamic(self#read_string)
-		| 4 -> FClosure(None,self#read_field_ref)
-		| 5 ->
-			let c = self#read_class_ref in
-			let tl = self#read_types in
-			let cf = self#read_field_ref in
-			FClosure(Some(c,tl),cf)
-		| 6 ->
-			let en = self#read_enum_ref in
-			let ef = self#read_enum_field_ref in
-			FEnum(en,ef)
-		| _ -> assert false
-
 	method read_var_kind =
 		match IO.read_byte ch with
 			| 0 -> VUser TVOLocalVariable
@@ -554,12 +538,12 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				let cf = self#read_field_ref in
+				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
-				let cf = self#read_field_ref in
+				let cf = self#read_field_ref c.cl_statics in
 				TField(e1,FStatic(c,cf))
 			| 104 ->
 				let e1 = self#read_texpr in
@@ -570,7 +554,7 @@ class hxb_reader
 				let e1 = self#read_texpr in
 				let c = self#read_class_ref in
 				let tl = self#read_types in
-				let cf = self#read_field_ref in
+				let cf = self#read_field_ref c.cl_fields in
 				TField(e1,FClosure(Some(c,tl),cf))
 			| 106 ->
 				let e1 = self#read_texpr in
@@ -686,11 +670,14 @@ 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;
 		self#read_type_parameters m ([],name) (fun a ->
 			field_type_parameters <- a
 		);
 		let params = Array.to_list field_type_parameters in
+		(* Printf.eprintf "  read type instance for %s\n" name; *)
 		let t = self#read_type_instance in
+		(* Printf.eprintf "  flags for %s (done) \n" name; *)
 		let flags = IO.read_i32 ch in
 		let pos = self#read_pos in
 		let name_pos = self#read_pos in
@@ -728,6 +715,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" (snd c.cl_path) (Array.length type_type_parameters);
+		Printf.eprintf "    own class params: %d\n" (List.length c.cl_params);
 		c.cl_constructor <- self#read_option f;
 		c.cl_ordered_fields <- self#read_list16 f;
 		c.cl_ordered_statics <- self#read_list16 f;
@@ -740,7 +729,9 @@ class hxb_reader
 		(* TODO: fix that *)
 		(* infos.mt_doc <- self#read_option (fun () -> self#read_documentation); *)
 		infos.mt_meta <- self#read_metadata;
+		Printf.eprintf "  read type parameters for %s\n" (snd infos.mt_path);
 		self#read_type_parameters m infos.mt_path (fun a ->
+			Printf.eprintf "  read type parameters for %s: %d\n" (snd infos.mt_path) (Array.length a);
 			type_type_parameters <- a
 		);
 		infos.mt_params <- Array.to_list type_type_parameters;
@@ -790,34 +781,47 @@ class hxb_reader
 		c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
 
 	method read_abstract (m : module_def) (a : tabstract) =
+		Printf.eprintf "  Read abstract %s\n" (snd a.a_path);
 		self#read_common_module_type m (Obj.magic a);
+		Printf.eprintf "1";
 		a.a_impl <- self#read_option (fun () -> self#read_class_ref);
+		Printf.eprintf "2";
 		a.a_this <- self#read_type_instance;
+		Printf.eprintf "3";
 		a.a_from <- self#read_list16 (fun () -> self#read_type_instance);
+		Printf.eprintf "4";
 		a.a_from_field <- self#read_list16 (fun () ->
 			let name = self#read_string in
 			self#read_type_parameters m ([],name) (fun a ->
 				field_type_parameters <- a
 			);
 			let t = self#read_type_instance in
-			let cf = self#read_field_ref in
+			let cf = self#read_field_ref (Option.get a.a_impl).cl_statics in
 			(t,cf)
 		);
+		Printf.eprintf "5";
 		a.a_to <- self#read_list16 (fun () -> self#read_type_instance);
+		Printf.eprintf "6";
 		a.a_to_field <- self#read_list16 (fun () ->
 			let name = self#read_string in
 			self#read_type_parameters m ([],name) (fun a ->
 				field_type_parameters <- a
 			);
 			let t = self#read_type_instance in
-			let cf = self#read_field_ref in
+			let cf = self#read_field_ref (Option.get a.a_impl).cl_fields in
 			(t,cf)
 		);
-		a.a_array <- self#read_list16 (fun () -> self#read_field_ref);
-		a.a_read <- self#read_option (fun () -> self#read_field_ref);
-		a.a_write <- self#read_option (fun () -> self#read_field_ref);
-		a.a_call <- self#read_option (fun () -> self#read_field_ref);
+		Printf.eprintf "7";
+		a.a_array <- self#read_list16 (fun () -> self#read_field_ref (Option.get a.a_impl).cl_statics);
+		Printf.eprintf "8";
+		a.a_read <- self#read_option (fun () -> self#read_field_ref (Option.get a.a_impl).cl_fields);
+		Printf.eprintf "9";
+		a.a_write <- self#read_option (fun () -> self#read_field_ref (Option.get a.a_impl).cl_fields);
+		Printf.eprintf "10";
+		a.a_call <- self#read_option (fun () -> self#read_field_ref (Option.get a.a_impl).cl_fields);
+		Printf.eprintf "11";
 		a.a_enum <- self#read_bool;
+		Printf.eprintf "12\n";
 
 	method read_enum (m : module_def) (e : tenum) =
 		(* TODO *)
@@ -917,7 +921,7 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		enums <- (Array.init l (fun i ->
 			let (pack,mname,tname) = self#read_full_path in
-			(* Printf.eprintf "  Read enmr %d of %d for abstract %s\n" i l tname; *)
+			Printf.eprintf "  Read enmr %d of %d for abstract %s\n" i l tname;
 			match resolve_type pack mname tname with
 			| TEnumDecl en ->
 				en
@@ -929,7 +933,7 @@ class hxb_reader
 		let l = self#read_uleb128 in
 		typedefs <- (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; *)
+			Printf.eprintf "  Read tpdr %d of %d for typedef %s.%s\n" i l mname tname;
 			match resolve_type pack mname tname with
 			| TTypeDecl tpd ->
 				tpd
@@ -989,7 +993,7 @@ class hxb_reader
 		) chunks in
 		let rec pass_0 chunks = match chunks with
 			| [] ->
-				raise (HxbFailure "Missing HHDR chunk")
+				error "Missing HHDR chunk"
 			| (kind,data) :: chunks ->
 				ch <- IO.input_bytes data;
 				match kind with
@@ -1011,11 +1015,11 @@ class hxb_reader
 					(* ) doc_pool; *)
 					pass_0 chunks
 				| _ ->
-					raise (HxbFailure ("Unexpected early chunk: " ^ (string_of_chunk_kind kind)))
+					error ("Unexpected early chunk: " ^ (string_of_chunk_kind kind))
 		in
 		let m,chunks = pass_0 chunks in
 		List.iter (fun (kind,data) ->
-			(* Printf.eprintf "Reading chunk %s\n" (string_of_chunk_kind kind); *)
+			Printf.eprintf " Reading chunk %s\n" (string_of_chunk_kind kind);
 			ch <- IO.input_bytes data;
 			match kind with
 			| TYPF ->
@@ -1029,18 +1033,18 @@ class hxb_reader
 				self#read_enmr;
 			| TPDR ->
 				self#read_tpdr;
+			| ABSD ->
+				self#read_absd m;
 			| CLSD ->
 				self#read_clsd m;
 			| CFLD ->
 				self#read_cfld m;
-			| ABSD ->
-				self#read_absd m;
 			| ENMD ->
 				self#read_enmd m;
 			| TPDD ->
 				self#read_tpdd m;
 			| _ ->
-				raise (HxbFailure ("Unexpected late chunk: " ^ (string_of_chunk_kind kind)))
+				error ("Unexpected late chunk: " ^ (string_of_chunk_kind kind))
 		) chunks;
 		m
 end

src/compiler/hxb/hxbWriter.ml

@@ -792,10 +792,12 @@ 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);
 			self#select_type a.a_path
 		| _ ->
 			self#select_type c.cl_path;
 		end;
+		Printf.eprintf "Write class %s with %d type params\n" (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);
@@ -831,8 +833,8 @@ class ['a] hxb_writer
 		chunk#write_list a.a_from_field (fun (t,cf) ->
 			chunk#write_string cf.cf_name;
 			self#set_field_type_parameters cf.cf_params;
-		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_forward;
+			chunk#write_list cf.cf_params self#write_type_parameter_data;
 			self#write_type_instance t;
 			self#write_field_ref (ClassStatic c) cf;
 		);
@@ -840,8 +842,8 @@ class ['a] hxb_writer
 		chunk#write_list a.a_to_field (fun (t,cf) ->
 			chunk#write_string cf.cf_name;
 			self#set_field_type_parameters cf.cf_params;
-		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_forward;
+			chunk#write_list cf.cf_params self#write_type_parameter_data;
 			self#write_type_instance t;
 			self#write_field_ref (ClassStatic c) cf;
 		);
@@ -881,6 +883,7 @@ class ['a] hxb_writer
 			3
 		in
 		let infos = t_infos mt in
+		Printf.eprintf "Forward declare type %s\n" (snd infos.mt_path);
 		chunk#write_byte i;
 		self#write_path infos.mt_path;
 		self#write_pos infos.mt_pos;
@@ -900,6 +903,16 @@ class ['a] hxb_writer
 		self#start_chunk TYPF;
 		chunk#write_list m.m_types self#forward_declare_type;
 
+		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);
+
+		begin match own_abstracts#to_list with
+		| [] ->
+			()
+		| own_abstracts ->
+			self#start_chunk ABSD;
+			chunk#write_list own_abstracts self#write_abstract;
+		end;
 		begin match own_classes#to_list with
 		| [] ->
 			()
@@ -919,13 +932,6 @@ class ['a] hxb_writer
 				chunk#write_list c.cl_ordered_statics self#write_class_field;
 			)
 		end;
-		begin match own_abstracts#to_list with
-		| [] ->
-			()
-		| own_abstracts ->
-			self#start_chunk ABSD;
-			chunk#write_list own_abstracts self#write_abstract;
-		end;
 		begin match own_enums#to_list with
 		| [] ->
 			()
@@ -947,6 +953,7 @@ 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)
 			)
 		end;
@@ -957,6 +964,7 @@ 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)
 			)
 		end;
@@ -967,6 +975,7 @@ 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)
 			)
 		end;
@@ -977,6 +986,7 @@ class ['a] hxb_writer
 			self#start_chunk TPDR;
 			chunk#write_list l (fun td ->
 				let m = td.t_module in
+				Printf.eprintf "  [tpd] 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)
 			)
 		end;

src/typing/typeloadModule.ml

@@ -802,6 +802,7 @@ let rec get_reader ctx input p =
 		let add_module m = ctx.com.module_lut#add m.m_path m in
 
 		let resolve_type pack mname tname =
+			Printf.eprintf "[typeloadModule] resolve type %s.%s\n" mname tname;
 			let m = try ctx.com.module_lut#find (pack,mname) with Not_found -> load_module' ctx ctx.g (pack,mname) p in
 			List.find (fun t -> snd (t_path t) = tname) m.m_types;
 		in