浏览代码

[hxb] export/load macro context too

Rudy Ges 2 年之前
父节点
当前提交
0ad819ba5d
共有 3 个文件被更改,包括 58 次插入34 次删除
  1. 31 23
      src/compiler/generate.ml
  2. 24 10
      src/compiler/hxb/hxbWriter.ml
  3. 3 1
      src/typing/typeloadModule.ml

+ 31 - 23
src/compiler/generate.ml

@@ -21,22 +21,24 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 	end
 
-let export_hxb com root m =
-	if m.m_extra.m_kind = MCode then begin
-		let anon_identification = new tanon_identification ([],"") in
-		let writer = new HxbWriter.hxb_writer anon_identification in
-		writer#write_module m;
-		let ch = IO.output_bytes() in
-		let bytes_module = IO.close_out ch in
-		let ch = IO.output_bytes() in
-		writer#export ch;
-		let bytes_cp = IO.close_out ch in
-		let l = (root :: fst m.m_path @ [snd m.m_path]) in
-		let ch_file = Path.create_file true ".hxb" [] l in
-		output_bytes ch_file bytes_cp;
-		output_bytes ch_file bytes_module;
-		close_out ch_file
-	end
+let export_hxb root m =
+	match m.m_extra.m_kind with
+		| MCode | MMacro -> begin
+			let anon_identification = new tanon_identification ([],"") in
+			let writer = new HxbWriter.hxb_writer anon_identification in
+			writer#write_module m;
+			let ch = IO.output_bytes() in
+			let bytes_module = IO.close_out ch in
+			let ch = IO.output_bytes() in
+			writer#export ch;
+			let bytes_cp = IO.close_out ch in
+			let l = (root :: fst m.m_path @ [snd m.m_path]) in
+			let ch_file = Path.create_file true ".hxb" [] l in
+			output_bytes ch_file bytes_cp;
+			output_bytes ch_file bytes_module;
+			close_out ch_file
+		end
+	| _ -> ()
 
 let check_hxb_output com actx =
 	begin match actx.hxb_out with
@@ -64,13 +66,19 @@ let check_hxb_output com actx =
 				iter_files [] (Unix.opendir path) path
 			in
 
-			let path = Path.add_trailing_slash path in
-			Common.log com ("Generating hxb to " ^ path);
-			Path.mkdir_from_path path;
-			clean_files path;
-			let t = Timer.timer ["generate";"hxb"] in
-			List.iter (export_hxb com path) com.modules;
-			t();
+			let export com =
+				let path = Path.add_trailing_slash (path ^ Path.path_sep ^ (Common.platform_name_macro com)) in
+				Common.log com ("Generating hxb to " ^ path);
+				Printf.eprintf "Generating hxb to %s\n" path;
+				Path.mkdir_from_path path;
+				clean_files path;
+				let t = Timer.timer ["generate";"hxb"] in
+				List.iter (export_hxb path) com.modules;
+				t();
+			in
+
+			export com;
+			Option.may export (com.get_macros());
 	end
 
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with

+ 24 - 10
src/compiler/hxb/hxbWriter.ml

@@ -1374,16 +1374,6 @@ class ['a] hxb_writer
 			chunk#write_list own_typedefs self#write_typedef;
 		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
 		| [] ->
@@ -1404,9 +1394,33 @@ class ['a] hxb_writer
 				chunk#write_list ttp self#write_type_parameter_forward;
 				chunk#write_list ttp self#write_type_parameter_data;
 				self#write_class_field { cf with cf_params = (cf.cf_params @ ftp#to_list) };
+				(* Printf.eprintf "Write anon field %s (done)\n" cf.cf_name; *)
 			);
 		end;
 
+		begin match anons#to_list with
+		| [] ->
+			()
+		| al ->
+			(* TODO clean this... currently loops until writing anons doesn't register any new anon *)
+			let rec loop written al =
+				let len = List.length al in
+				(* Printf.eprintf "Write ANND - %d anons registered for %s\n" len (s_type_path current_module.m_path); *)
+
+				self#start_chunk ANND;
+				(* TODO this is wasteful... *)
+				chunk#write_list al (fun an -> self#write_anon m an);
+
+				let al = anons#to_list in
+				let new_len = List.length al in
+				if len = new_len then begin
+					self#start_chunk ANNR;
+					chunk#write_uleb128 len;
+				end else loop len al;
+			in
+			loop 0 al
+		end;
+
 		begin match classes#to_list with
 		| [] ->
 			()

+ 3 - 1
src/typing/typeloadModule.ml

@@ -824,7 +824,9 @@ and load_hxb_module ctx path p =
 		) ^ ".hxb"
 	in
 
-	let find_file = Common.find_file ctx.com ~class_path:ctx.com.binary_class_path in
+	let target = Common.platform_name_macro ctx.com in
+	let bcp = List.map (fun p -> p ^ target ^ Path.path_sep) ctx.com.binary_class_path in
+	let find_file = Common.find_file ctx.com ~class_path:bcp in
 	let file = try find_file (compose_path false) with Not_found -> find_file (compose_path true) in
 	let ch = try open_in_bin file with Sys_error _ -> raise Not_found in
 	let input = IO.input_channel ch in