start on writer config

src/compiler/args.ml

@@ -278,9 +278,9 @@ let parse_args com =
 		("Services",["--json"],[],Arg.String (fun file ->
 			actx.json_out <- Some file
 		),"<file>","generate JSON types description");
-		("Services",["--hxb"],[], Arg.String (fun dir ->
-			actx.hxb_out <- Some dir;
-		),"<directory>", "generate haxe binary representation in target directory");
+		("Services",["--hxb"],[], Arg.String (fun file ->
+			actx.hxb_out <- Some file;
+		),"<directory>", "generate haxe binary representation to target archive");
 		("Optimization",["--no-output"],[], Arg.Unit (fun() -> actx.no_output <- true),"","compiles but does not generate any file");
 		("Debug",["--times"],[], Arg.Unit (fun() -> Timer.measure_times := true),"","measure compilation times");
 		("Optimization",["--no-inline"],[],Arg.Unit (fun () ->

src/compiler/compiler.ml

@@ -369,6 +369,12 @@ let compile ctx actx callbacks =
 	callbacks.after_target_init ctx;
 	let t = Timer.timer ["init"] in
 	List.iter (fun f -> f()) (List.rev (actx.pre_compilation));
+	begin match actx.hxb_out with
+		| None ->
+			()
+		| Some file ->
+			com.hxb_writer_config <- HxbWriterConfig.process_argument (platform_name com.platform) file
+	end;
 	t();
 	enter_stage com CInitialized;
 	ServerMessage.compiler_stage com;
@@ -382,7 +388,11 @@ let compile ctx actx callbacks =
 		let is_compilation = is_compilation com in
 		com.callbacks#add_after_save (fun () ->
 			callbacks.after_save ctx;
-			if is_compilation then Generate.check_hxb_output ctx actx;
+			if is_compilation then match com.hxb_writer_config with
+				| Some config ->
+					Generate.check_hxb_output ctx config;
+				| None ->
+					()
 		);
 		if is_diagnostics com then
 			filter ctx tctx (fun () -> DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path)

src/compiler/generate.ml

@@ -51,37 +51,45 @@ let export_hxb com cc platform zip m =
 	| _ ->
 		()
 
-let check_hxb_output ctx actx =
+let check_hxb_output ctx config =
+	let open HxbWriterConfig in
 	let com = ctx.com in
-	let try_write path =
+	let match_path_list l sl_path =
+		List.exists (fun sl -> Ast.match_path true sl_path sl) l
+	in
+	let try_write () =
+		let path = config.HxbWriterConfig.archive_path in
 		let t = Timer.timer ["generate";"hxb"] in
 		Path.mkdir_from_path path;
 		let zip = new Zip_output.zip_output path 6 in
-		let export com =
+		let export com config =
 			let cc = CommonCache.get_cache com in
 			let target = Common.platform_name_macro com in
 			List.iter (fun m ->
 				let t = Timer.timer ["generate";"hxb";s_type_path m.m_path] in
-				Std.finally t (export_hxb com cc target zip) m
+				let sl_path = fst m.m_path @ [snd m.m_path] in
+				if not (match_path_list config.exclude sl_path) || match_path_list config.include' sl_path then
+					Std.finally t (export_hxb com cc target zip) m
 			) com.modules;
 		in
 		Std.finally (fun () ->
 			zip#close;
 			t()
 		) (fun () ->
-			export com;
-			Option.may export (com.get_macros());
+			if  config.target_config.generate then
+				export com config.target_config;
+			begin match com.get_macros() with
+				| Some mcom when config.macro_config.generate ->
+					export mcom config.macro_config
+				| _ ->
+					()
+			end;
 		) ()
 	in
-	begin match actx.hxb_out with
-		| None ->
-			()
-		| Some path ->
-			try
-				try_write path
-			with Sys_error s ->
-				error ctx (Printf.sprintf "Could not write to %s: %s" path s) null_pos
-	end
+	try
+		try_write ()
+	with Sys_error s ->
+		CompilationContext.error ctx (Printf.sprintf "Could not write to %s: %s" config.archive_path s) null_pos
 
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
 		| [width; height; fps] ->

src/compiler/hxb/hxbWriterConfig.ml

@@ -0,0 +1,114 @@
+open Globals
+open Json
+open Json.Reader
+
+type writer_target_config = {
+	mutable generate : bool;
+	mutable exclude : string list list;
+	mutable include' : string list list;
+	mutable hxb_version : int;
+}
+
+type t = {
+	mutable archive_path : string;
+	target_config : writer_target_config;
+	macro_config : writer_target_config;
+}
+
+let create_target_config () = {
+	generate = true;
+	exclude = [];
+	include'= [];
+	hxb_version = HxbData.hxb_version;
+}
+
+let create () = {
+	archive_path = "";
+	target_config = create_target_config ();
+	macro_config = create_target_config ()
+}
+
+let error s =
+	Error.raise_typing_error s null_pos
+
+let process_json config target_name json =
+	let read_string = function
+		| JString s -> s
+		| json -> error (Printf.sprintf "Invalid JSON where string was expected: %s" (string_of_json json))
+	in
+	let read_int = function
+		| JInt i -> i
+		| json -> error (Printf.sprintf "Invalid JSON where integer was expected: %s" (string_of_json json))
+	in
+	let read_bool = function
+		| JBool b -> b
+		| json -> error (Printf.sprintf "Invalid JSON where bool was expected: %s" (string_of_json json))
+	in
+	let read_array_or_null f json = match json with
+		| JNull ->
+			[]
+		| JArray jl ->
+			List.map f jl
+		| _ ->
+			error (Printf.sprintf "Invalid JSON where array was expected: %s" (string_of_json json))
+	in
+	let read_object_or_null f json = match json with
+		| JNull ->
+			()
+		| JObject fl ->
+			f fl
+		| _ ->
+			error (Printf.sprintf "Invalid JSON where object was expected: %s" (string_of_json json))
+	in
+	let read_target_config config fl =
+		List.iter (fun (s,json) -> match s with
+			| "generate" ->
+				config.generate <- read_bool json;
+			| "exclude" ->
+				config.exclude <- read_array_or_null (fun json -> ExtString.String.nsplit (read_string json) ".") json
+			| "include" ->
+				config.include' <- read_array_or_null (fun json -> ExtString.String.nsplit (read_string json) ".") json
+			| "hxbVersion" ->
+				config.hxb_version <- read_int json
+			| s ->
+				error (Printf.sprintf "Unknown key for target config: %s" s)
+		) fl;
+	in
+	let read_writer_config fl =
+		List.iter (fun (s,json) ->
+			match s with
+			| "archivePath" ->
+				let path = read_string json in
+				let path = Str.global_replace (Str.regexp "\\$target") target_name path in
+				config.archive_path <- path;
+			| "targetConfig" ->
+				read_object_or_null (read_target_config config.target_config) json
+			| "macroConfig" ->
+				read_object_or_null (read_target_config config.macro_config) json
+			| s ->
+				error (Printf.sprintf "Unknown key for writer config: %s" s)
+		) fl;
+	in
+	read_object_or_null read_writer_config json
+
+let parse config target_name input =
+	let lexbuf = Sedlexing.Utf8.from_string input in
+	let json = read_json lexbuf in
+	process_json config target_name json
+
+let process_argument target_name file =
+	let config = create () in
+	begin match Path.file_extension file with
+		| "json" ->
+			let file = try
+				open_in file
+			with exc ->
+				error (Printf.sprintf "Could not open file %s: %s" file (Printexc.to_string exc))
+			in
+			let data = Std.input_all file in
+			close_in file;
+			parse config target_name data;
+		| _ ->
+			config.archive_path <- file;
+	end;
+	Some config

src/context/common.ml

@@ -418,6 +418,7 @@ type context = {
 	memory_marker : float array;
 	hxb_reader_stats : HxbReader.hxb_reader_stats;
 	hxb_writer_stats : HxbWriter.hxb_writer_stats;
+	mutable hxb_writer_config : HxbWriterConfig.t option;
 }
 
 let enter_stage com stage =
@@ -879,6 +880,7 @@ let create compilation_step cs version args display_mode =
 		is_macro_context = false;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_stats = HxbWriter.create_hxb_writer_stats ();
+		hxb_writer_config = None;
 	} in
 	com
 

std/haxe/hxb/WriterConfig.hx

@@ -0,0 +1,46 @@
+package haxe.hxb;
+
+typedef WriterTargetConfig = {
+	/**
+		If `false`, this target is ignored by the writer.
+	**/
+	var generate:Null<Bool>;
+
+	/**
+		Dot paths of modules or packages to be exluded from the archive.
+	**/
+	var exclude:Null<Array<String>>;
+
+	/**
+		Dot paths of modules or packages to be included in the archive. This takes priority
+		over exclude. By default, all modules that aren't explicitly excluded are
+		included.
+	**/
+	var include:Null<Array<String>>;
+
+	/**
+		The hxb version to target. By default, the version of the Haxe compiler itself
+		is targeted. See https://github.com/HaxeFoundation/haxe/issues/11505
+	**/
+	var hxbVersion:Null<Int>;
+}
+
+typedef WriterConfig = {
+	/**
+		The file path for the archive. Occurrences of `$target` are replaced
+		by the name of the current target (js, hl, etc.).
+	**/
+	var archivePath:String;
+
+	/**
+		The configuration for the current target context. If it is `null`, all data
+		for the target context is generated.
+	**/
+	var targetConfig:Null<WriterTargetConfig>;
+
+	/**
+		The configuration for the macro context. If it is `null`, all data for the
+		macro context is generated.
+	**/
+	var macroConfig:Null<WriterTargetConfig>;
+}

tests/unit/compile-hxb-jvm-roundtrip.hxml

@@ -1,7 +1,7 @@
 compile-jvm-only.hxml
---hxb bin/hxb/jvm.zip
+--hxb hxb-config/jvm.json
 
 --next
 
 compile-jvm-only.hxml
---hxb-lib bin/hxb/jvm.zip
+--hxb-lib bin/hxb/unit.java.zip

tests/unit/hxb-config/jvm.json

@@ -0,0 +1,6 @@
+{
+	"archivePath": "bin/hxb/unit.$target.zip",
+	"targetConfig": {
+		"exclude": ["unit.TestMainNow"]
+	}
+}

tests/unit/src/unit/TestMain.hx

@@ -31,9 +31,7 @@ function main() {
 	cs.system.threading.Thread.CurrentThread.CurrentCulture = new cs.system.globalization.CultureInfo('tr-TR');
 	cs.Lib.applyCultureChanges();
 	#end
-	#if !macro
-	trace("Generated at: " + HelperMacros.getCompilationDate());
-	#end
+	TestMainNow.printNow();
 	trace("START");
 	#if flash
 	var tf:flash.text.TextField = untyped flash.Boot.getTrace();

tests/unit/src/unit/TestMainNow.hx

@@ -0,0 +1,9 @@
+package unit;
+
+class TestMainNow {
+	static public function printNow() {
+		#if !macro
+		trace("Generated at: " + HelperMacros.getCompilationDate());
+		#end
+	}
+}