change -bcp to --hxb-lib

src/compiler/args.ml

@@ -59,6 +59,7 @@ let parse_args com =
 		interp = false;
 		jvm_flag = false;
 		swf_version = false;
+		hxb_libs = [];
 		native_libs = [];
 		raise_usage = (fun () -> ());
 		display_arg = None;
@@ -129,9 +130,10 @@ let parse_args com =
 		("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
 			com.class_path <- Path.add_trailing_slash path :: com.class_path
 		),"<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",["--hxb-lib"],["-hxb-lib"],Arg.String (fun file ->
+			let lib = create_native_lib file false HxbLib in
+			actx.hxb_libs <- lib :: actx.hxb_libs
+		),"<path>","add a hxb library");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
 			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
 			let cpath = Path.parse_type_path cl in

src/compiler/compilationContext.ml

@@ -11,6 +11,7 @@ type native_lib_kind =
 	| NetLib
 	| JavaLib
 	| SwfLib
+	| HxbLib
 
 type native_lib_arg = {
 	lib_file : string;
@@ -32,6 +33,7 @@ type arg_context = {
 	mutable interp : bool;
 	mutable jvm_flag : bool;
 	mutable swf_version : bool;
+	mutable hxb_libs : native_lib_arg list;
 	mutable native_libs : native_lib_arg list;
 	mutable raise_usage : unit -> unit;
 	mutable display_arg : string option;

src/compiler/compiler.ml

@@ -162,7 +162,13 @@ module Setup = struct
 				add_std "eval";
 				"eval"
 
-	let create_typer_context ctx macros native_libs =
+	let init_native_libs com native_libs =
+		(* Native lib pass 1: Register *)
+		let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in
+		(* Native lib pass 2: Initialize *)
+		List.iter (fun f -> f()) fl
+
+	let create_typer_context ctx macros =
 		let com = ctx.com in
 		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
 		let buffer = Buffer.create 64 in
@@ -174,10 +180,6 @@ module Setup = struct
 		Buffer.truncate buffer (Buffer.length buffer - 1);
 		Common.log com (Buffer.contents buffer);
 		com.callbacks#run com.error_ext com.callbacks#get_before_typer_create;
-		(* Native lib pass 1: Register *)
-		let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in
-		(* Native lib pass 2: Initialize *)
-		List.iter (fun f -> f()) fl;
 		TyperEntry.create com macros
 
 	let executable_path() =
@@ -280,6 +282,8 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
 	enter_stage com CInitMacrosStart;
 	ServerMessage.compiler_stage com;
 
+	Setup.init_native_libs com actx.hxb_libs;
+
 	let mctx = List.fold_left (fun mctx path ->
 		Some (MacroContext.call_init_macro ctx.com mctx path)
 	) mctx (List.rev actx.config_macros) in
@@ -288,7 +292,8 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
 	MacroContext.macro_enable_cache := macro_cache_enabled;
 
 	let macros = match mctx with None -> None | Some mctx -> mctx.g.macros in
-	let tctx = Setup.create_typer_context ctx macros actx.native_libs in
+	Setup.init_native_libs com actx.native_libs;
+	let tctx = Setup.create_typer_context ctx macros in
 	let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
 	check_defines ctx.com;
 	CommonCache.lock_signature com "after_init_macros";
@@ -437,6 +442,7 @@ with
 
 let finalize ctx =
 	ctx.comm.flush ctx;
+	List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
 	(* In server mode any open libs are closed by the lib_build_task. In offline mode
 		we should do it here to be safe. *)
 	if not ctx.comm.is_server then begin

src/compiler/generate.ml

@@ -21,60 +21,41 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 	end
 
-let export_hxb com root m =
+let export_hxb com platform zip 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 (MessageReporting.display_source_at com) anon_identification com.hxb_writer_stats in
 			writer#write_module m;
-			let l = (root :: fst m.m_path @ [snd m.m_path]) in
-			let ch = Path.create_file true ".hxb" [] l in
-			writer#export (IO.output_channel ch);
-			close_out ch
+			let l = platform :: (fst m.m_path @ [snd m.m_path]) in
+			let path = (String.concat "/" l) ^ ".hxb" in
+			let out = IO.output_string () in
+			writer#export out;
+			zip#add_entry (IO.close_out out) path;
 		end
-	| _ -> ()
+	| _ ->
+		()
 
 let check_hxb_output com actx =
 	begin match actx.hxb_out with
 		| None -> ()
 		| Some path ->
-			(* TODO move somewhere else *)
-			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 zip = new Zip_output.zip_output path 6 in
 			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
 				Printf.eprintf "%d modules, %d types\n" (List.length com.modules) (List.length com.types);
-				List.iter (export_hxb com path) com.modules;
+				let target = Common.platform_name_macro com in
+				List.iter (export_hxb com target zip) com.modules;
 				t();
 			in
-
-			export com;
-			Option.may export (com.get_macros());
+			Std.finally (fun () -> zip#close) (fun () ->
+				export com;
+				Option.may export (com.get_macros());
+			) ()
 	end
 
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with

src/compiler/hxb/hxbLib.ml

@@ -0,0 +1,66 @@
+open Globals
+open Common
+open NativeLibraries
+open ExtString
+
+class hxb_library file_path = object(self)
+	inherit abstract_hxb_lib
+	val zip = lazy (Zip.open_in file_path)
+
+	val mutable cached_files = []
+	val modules = Hashtbl.create 0
+	val mutable closed = false
+	val mutable loaded = false
+
+	method load =
+		if not loaded then begin
+			loaded <- true;
+			let close = Timer.timer ["hxblib";"read"] in
+			List.iter (function
+				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".hxb" ->
+					let pack = String.nsplit filename "/" in
+					begin match List.rev pack with
+						| [] -> ()
+						| name :: pack ->
+							let name = String.sub name 0 (String.length name - 4) in
+							let pack = List.rev pack in
+							Hashtbl.add modules (pack,name) (filename,entry);
+						end
+				| _ -> ()
+			) (Zip.entries (Lazy.force zip));
+			close();
+		end
+
+	method load_module (target : string) (path : path) =
+		try
+			(* HXB_TODO: See if we can bucket by target a bit nicer. *)
+			let path = (target :: fst path,snd path) in
+			let (filename,entry) = Hashtbl.find modules path in
+			let close = Timer.timer ["hxblib";"load_module"] in
+			let zip = Lazy.force zip in
+			let data = Zip.read_entry zip entry in
+			let input = IO.input_string data in
+			close();
+			Some input
+		with Not_found ->
+			None
+
+	method close =
+		if not closed then begin
+			closed <- true;
+			Zip.close_in (Lazy.force zip)
+		end
+
+	method get_file_path = file_path
+end
+
+
+let create_hxb_lib com file_path =
+	let file = if Sys.file_exists file_path then
+		file_path
+	else try
+		Common.find_file com file_path
+	with Not_found ->
+			failwith ("hxb lib " ^ file_path ^ " not found")
+	in
+	new hxb_library file

src/context/common.ml

@@ -334,6 +334,13 @@ class module_lut = object(self)
 	method get_type_lut = type_lut
 end
 
+class virtual abstract_hxb_lib = object(self)
+	method virtual load : unit
+	method virtual load_module : string -> path -> IO.input option
+	method virtual close : unit
+	method virtual get_file_path : string
+end
+
 type context = {
 	compilation_step : int;
 	mutable stage : compiler_stage;
@@ -404,6 +411,7 @@ type context = {
 	mutable neko_lib_paths : string list;
 	mutable include_files : (string * string) list;
 	mutable native_libs : native_libraries;
+	mutable hxb_libs : abstract_hxb_lib list;
 	mutable net_std : string list;
 	net_path_map : (path,string list * string list * string) Hashtbl.t;
 	mutable c_args : string list;
@@ -829,6 +837,7 @@ let create compilation_step cs version args display_mode =
 		resources = Hashtbl.create 0;
 		net_std = [];
 		native_libs = create_native_libs();
+		hxb_libs = [];
 		net_path_map = Hashtbl.create 0;
 		c_args = [];
 		neko_lib_paths = [];

src/context/nativeLibraryHandler.ml

@@ -49,3 +49,9 @@ let add_native_lib com lib =
 			| _ -> failwith ("unsupported file@`std` format: " ^ file)
 		in
 		Dotnet.add_net_lib com file is_std is_extern
+	| HxbLib ->
+		let hxb_lib = HxbLib.create_hxb_lib com file in
+		com.hxb_libs <- hxb_lib :: com.hxb_libs;
+		(fun () ->
+			hxb_lib#load
+		)

src/core/zip_output.ml

@@ -0,0 +1,18 @@
+class virtual any_output = object(self)
+	method virtual add_entry : string -> string -> unit
+	method virtual close : unit
+end
+
+class zip_output
+	(zip_path : string)
+	(compression_level : int)
+= object(self)
+	inherit any_output
+	val zip = Zip.open_out zip_path
+
+	method add_entry (content : string) (name : string) =
+		Zip.add_entry ~level:compression_level content zip name
+
+	method close =
+		Zip.close_out zip
+end

src/generators/genjvm.ml

@@ -50,16 +50,11 @@ let get_construction_mode c cf =
 	if Meta.has Meta.HxGen cf.cf_meta then ConstructInitPlusNew
 	else ConstructInit
 
-class virtual jvm_output = object(self)
-	method virtual add_entry : string -> string -> unit
-	method virtual close : unit
-end
-
 (* Haxe *)
 
 type generation_context = {
 	com : Common.context;
-	out : jvm_output;
+	out : Zip_output.any_output;
 	t_runtime_exception : Type.t;
 	entry_point : (tclass * texpr) option;
 	t_exception : Type.t;
@@ -109,24 +104,10 @@ let run_timed gctx detail name f =
 		sub#run_finally f (fun () -> gctx.timer <- old)
 	end
 
-class jar_output
-	(jar_path : string)
-	(compression_level : int)
-= object(self)
-	inherit jvm_output
-	val jar = Zip.open_out jar_path
-
-	method add_entry (content : string) (name : string) =
-		Zip.add_entry ~level:compression_level content jar name
-
-	method close =
-		Zip.close_out jar
-end
-
 class file_output
 	(base_path : string)
 	= object(self)
-	inherit jvm_output
+	inherit Zip_output.any_output
 
 	method add_entry (content : string) (name : string) =
 		let path = base_path ^ name in
@@ -3031,7 +3012,7 @@ let generate jvm_flag com =
 	in
 	if compression_level < 0 || compression_level > 9 then failwith "Invalid value for -D jvm.compression-level: Must be >=0 and <= 9";
 	let create_jar path =
-		new jar_output path compression_level
+		new Zip_output.zip_output path compression_level
 	in
 	let out_dir,out = if jvm_flag then begin
 		match path.file_name with

src/typing/typeloadModule.ml

@@ -804,34 +804,28 @@ let rec get_reader ctx p =
 	new hxb_reader_api_typeload ctx load_module' p
 
 and load_hxb_module ctx path p =
-	let compose_path no_rename =
-		(match path with
-		| [] , name -> name
-		| x :: l , name ->
-			String.concat "/" (x :: l) ^ "/" ^ name
-		) ^ ".hxb"
+	let read file input =
+		try
+			(get_reader ctx p)#read_hxb input ctx.com.hxb_reader_stats
+		with e ->
+			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;
+			raise e
 	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
-
-	(* TODO use finally instead *)
-	try
-		(* Printf.eprintf "[%s] Read module %s\n" target (s_type_path path); *)
-		let m = (get_reader ctx p)#read_hxb input ctx.com.hxb_reader_stats in
-		(* Printf.eprintf "[%s] Done reading module %s\n" target (s_type_path path); *)
-		close_in ch;
-		m
-	with e ->
-		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;
-		raise e
+	let rec loop l = match l with
+		| hxb_lib :: l ->
+			begin match hxb_lib#load_module target path with
+				| Some input ->
+					read hxb_lib#get_file_path input
+				| None ->
+					loop l
+			end
+		| [] ->
+			raise Not_found
+	in
+	loop ctx.com.hxb_libs
 
 and load_module' ctx m p =
 	try

tests/unit/compile-hxb-interp.hxml

@@ -1,4 +1,4 @@
 compile-each.hxml
 --main unit.TestMain
 --interp
---hxb bin/hxb
+--hxb bin/hxb/eval.zip

tests/unit/compile-read-hxb-interp.hxml

@@ -17,4 +17,4 @@
 --main unit.TestMain
 --interp
 # --hxb bin/hxb
--bcp bin/hxb
+--hxb-lib bin/hxb/eval.zip