Browse Source

[hxb] load hxb files from -bcp arg

Rudy Ges 2 năm trước cách đây
mục cha
commit
7528a11188

+ 3 - 0
src/compiler/args.ml

@@ -127,6 +127,9 @@ let parse_args com =
 		("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
 		("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
 			com.class_path <- Path.add_trailing_slash path :: com.class_path
 			com.class_path <- Path.add_trailing_slash path :: com.class_path
 		),"<path>","add a directory to find source files");
 		),"<path>","add a directory to find source files");
+		("Compilation",["--binary-class-path"],["-bcp"],Arg.String (fun path ->
+			com.binary_class_path <- Path.add_trailing_slash path :: com.binary_class_path
+		),"<path>","add a directory to find binary source files");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
 			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
 			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
 			begin match Path.file_extension cl with
 			begin match Path.file_extension cl with

+ 1 - 0
src/compiler/compiler.ml

@@ -365,6 +365,7 @@ let compile ctx actx callbacks =
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
 		finalize_typing ctx tctx;
 		finalize_typing ctx tctx;
 		DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path;
 		DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path;
+		(* TODO check if this is fine for xml and json output *)
 		Generate.check_auxiliary_output com actx;
 		Generate.check_auxiliary_output com actx;
 		filter ctx tctx;
 		filter ctx tctx;
 		if ctx.has_error then raise Abort;
 		if ctx.has_error then raise Abort;

+ 34 - 13
src/compiler/generate.ml

@@ -3,19 +3,17 @@ open CompilationContext
 open TType
 open TType
 open Tanon_identification
 open Tanon_identification
 
 
-let export_hxb com m =
+let export_hxb com root m =
 	if m.m_extra.m_kind = MCode then begin
 	if m.m_extra.m_kind = MCode then begin
-		let ch = IO.output_bytes() in
 		let anon_identification = new tanon_identification ([],"") in
 		let anon_identification = new tanon_identification ([],"") in
-		let writer = new HxbWriter.hxb_writer anon_identification (* cp *) in
+		let writer = new HxbWriter.hxb_writer anon_identification in
 		writer#write_module m;
 		writer#write_module m;
+		let ch = IO.output_bytes() in
 		let bytes_module = IO.close_out ch in
 		let bytes_module = IO.close_out ch in
 		let ch = IO.output_bytes() in
 		let ch = IO.output_bytes() in
 		writer#export ch;
 		writer#export ch;
 		let bytes_cp = IO.close_out ch in
 		let bytes_cp = IO.close_out ch in
-		let path = m.m_path in
-		(* TODO use actual hxb output path *)
-		let l = ((Common.dump_path com) :: "hxb" :: (Common.platform_name_macro com) :: fst path @ [snd path]) in
+		let l = (root :: fst m.m_path @ [snd m.m_path]) in
 		let ch_file = Path.create_file true ".hxb" [] l in
 		let ch_file = Path.create_file true ".hxb" [] l in
 		output_bytes ch_file bytes_cp;
 		output_bytes ch_file bytes_cp;
 		output_bytes ch_file bytes_module;
 		output_bytes ch_file bytes_module;
@@ -41,13 +39,36 @@ let check_auxiliary_output com actx =
 	end;
 	end;
 	begin match actx.hxb_out with
 	begin match actx.hxb_out with
 		| None -> ()
 		| None -> ()
-		| Some file ->
-				Common.log com ("Generating hxb : " ^ file);
-				Path.mkdir_from_path file;
-				let t = Timer.timer ["generate";"hxb"] in
-				(* HxbWriter.write com file; *)
-				List.iter (export_hxb com) com.modules;
-				t();
+		| Some path ->
+			let clean_files path =
+				let rec iter_files pack dir path = try
+					let file = Unix.readdir dir in
+
+					if file <> "." && file <> ".." then begin
+						let filepath = path ^ "/" ^ file in
+						if (Unix.stat filepath).st_kind = S_DIR then
+							let pack = pack @ [file] in
+							iter_files (pack) (Unix.opendir filepath) filepath;
+							try Unix.rmdir filepath with Unix.Unix_error (ENOTEMPTY,_,_) -> ();
+						else
+							Sys.remove filepath
+					end;
+
+					iter_files pack dir path
+				with | End_of_file | Unix.Unix_error _ ->
+					Unix.closedir dir
+				in
+				iter_files [] (Unix.opendir path) path
+			in
+
+			let path = Path.add_trailing_slash path in
+			Common.log com ("Generating hxb : " ^ 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 com path) com.modules;
+			t();
 	end
 	end
 
 
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with

+ 4 - 2
src/context/common.ml

@@ -373,6 +373,7 @@ type context = {
 	mutable config : platform_config;
 	mutable config : platform_config;
 	mutable std_path : string list;
 	mutable std_path : string list;
 	mutable class_path : string list;
 	mutable class_path : string list;
+	mutable binary_class_path : string list;
 	mutable main_class : path option;
 	mutable main_class : path option;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable report_mode : report_mode;
 	mutable report_mode : report_mode;
@@ -823,6 +824,7 @@ let create compilation_step cs version args =
 		run_command_args = (fun s args -> com.run_command (Printf.sprintf "%s %s" s (String.concat " " args)));
 		run_command_args = (fun s args -> com.run_command (Printf.sprintf "%s %s" s (String.concat " " args)));
 		std_path = [];
 		std_path = [];
 		class_path = [];
 		class_path = [];
+		binary_class_path = [];
 		main_class = None;
 		main_class = None;
 		package_rules = PMap.empty;
 		package_rules = PMap.empty;
 		file = "";
 		file = "";
@@ -1126,7 +1128,7 @@ let cache_directory ctx class_path dir f_dir =
 	in
 	in
 	Option.may (Array.iter prepare_file) dir_listing
 	Option.may (Array.iter prepare_file) dir_listing
 
 
-let find_file ctx f =
+let find_file ctx ?(class_path=ctx.class_path) f =
 	try
 	try
 		match ctx.file_lookup_cache#find f with
 		match ctx.file_lookup_cache#find f with
 		| None -> raise Exit
 		| None -> raise Exit
@@ -1161,7 +1163,7 @@ let find_file ctx f =
 						loop (had_empty || p = "") l
 						loop (had_empty || p = "") l
 				end
 				end
 		in
 		in
-		let r = try Some (loop false ctx.class_path) with Not_found -> None in
+		let r = try Some (loop false class_path) with Not_found -> None in
 		ctx.file_lookup_cache#add f r;
 		ctx.file_lookup_cache#add f r;
 		match r with
 		match r with
 		| None -> raise Not_found
 		| None -> raise Not_found

+ 17 - 17
src/typing/typeloadModule.ml

@@ -806,8 +806,7 @@ let rec get_reader ctx input mpath p =
 
 
 		let add_module m =
 		let add_module m =
 			(* Printf.eprintf "  \x1b[35m[typeloadModule]\x1b[0m add module %s = %s\n" (s_type_path m.m_path) (s_type_path mpath); *)
 			(* Printf.eprintf "  \x1b[35m[typeloadModule]\x1b[0m add module %s = %s\n" (s_type_path m.m_path) (s_type_path mpath); *)
-			ctx.com.module_lut#add mpath m in
-			(* ctx.com.module_lut#add m.m_path m in *)
+			ctx.com.module_lut#add m.m_path m in
 
 
 		let resolve_type pack mname tname =
 		let resolve_type pack mname tname =
 			(* Printf.eprintf "  \x1b[35m[typeloadModule]\x1b[0m resolve type %s\n" (s_type_path ((pack @ [mname]),tname)); *)
 			(* Printf.eprintf "  \x1b[35m[typeloadModule]\x1b[0m resolve type %s\n" (s_type_path ((pack @ [mname]),tname)); *)
@@ -820,28 +819,28 @@ let rec get_reader ctx input mpath p =
 		new HxbReader.hxb_reader ctx.com input make_module add_module resolve_type
 		new HxbReader.hxb_reader ctx.com input make_module add_module resolve_type
 
 
 and load_hxb_module ctx path p =
 and load_hxb_module ctx path p =
-	(* let mk_indent indent = *)
-	(* 	ExtLib.String.make (indent*2) ' ' *)
-	(* in *)
-
-	let l = ((Common.dump_path ctx.com) :: "hxb" :: (Common.platform_name_macro ctx.com) :: fst path @ [snd path]) in
-	let filepath = (List.fold_left (fun acc s -> acc ^ "/" ^ s) "." l) ^ ".hxb" in
-	let ch = try open_in_bin filepath with Sys_error _ -> raise Not_found in
+	let compose_path no_rename =
+		(match path with
+		| [] , name -> name
+		| x :: l , name ->
+			String.concat "/" (x :: l) ^ "/" ^ name
+		) ^ ".hxb"
+	in
+
+	let find_file = Common.find_file ctx.com ~class_path:ctx.com.binary_class_path 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
 	let input = IO.input_channel ch in
 
 
-	indent := !indent + 1;
-	(* Printf.eprintf "%s\x1b[44m>> Loading %s from %s...\x1b[0m\n" (mk_indent !indent) (snd path) filepath; *)
+	(* TODO use finally instead *)
 	try
 	try
 		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\x1b[44m<< Loaded %s from %s\x1b[0m\n" (mk_indent !indent) (snd m.m_path) filepath; *)
-		indent := !indent - 1;
 		close_in ch;
 		close_in ch;
 		m
 		m
 	with e ->
 	with e ->
-		(* Printf.eprintf "%s\x1b[44m<< Error loading %s from %s\x1b[0m\n" (mk_indent !indent) (snd path) filepath; *)
-		(* let msg = Printexc.to_string e and stack = Printexc.get_backtrace () in *)
-		(* Printf.eprintf "%s => %s\n%s\n" (mk_indent !indent) msg stack; *)
-		indent := !indent - 1;
+		Printf.eprintf "\x1b[30;41mError loading %s from %s\x1b[0m\n" (snd path) file;
+		let msg = Printexc.to_string e and stack = Printexc.get_backtrace () in
+		Printf.eprintf " => %s\n%s\n" msg stack;
 		close_in ch;
 		close_in ch;
 		raise e
 		raise e
 
 
@@ -857,6 +856,7 @@ and load_module' ctx g m p =
 		match !type_module_hook ctx m p with
 		match !type_module_hook ctx m p with
 		| Some m ->
 		| Some m ->
 			m
 			m
+		(* Try loading from hxb first *)
 		| None -> try load_hxb_module ctx m p with Not_found ->
 		| None -> try load_hxb_module ctx m p with Not_found ->
 			let raise_not_found () = raise_error_msg (Module_not_found m) p in
 			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.com.module_nonexistent_lut#mem m then raise_not_found();