activate

src/compiler/generate.ml

@@ -21,7 +21,17 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 	end
 
-let export_hxb com cc platform zip m =
+let create_writer com string_pool =
+	let anon_identification = new tanon_identification in
+	let warn w s p = com.Common.warning w com.warning_options s p in
+	let writer = HxbWriter.create string_pool warn anon_identification com.hxb_writer_stats in
+	writer,(fun () ->
+		let out = IO.output_string () in
+		HxbWriter.export writer out;
+		IO.close_out out
+	)
+
+let export_hxb com cc string_pool platform zip m =
 	let open HxbData in
 	match m.m_extra.m_kind with
 		| MCode | MMacro | MFake | MExtern -> begin
@@ -40,29 +50,34 @@ let export_hxb com cc platform zip m =
 				let data = IO.close_out out in
 				zip#add_entry data path;
 			with Not_found ->
-				let anon_identification = new tanon_identification in
-				let warn w s p = com.Common.warning w com.warning_options s p in
-				let writer = HxbWriter.create None warn anon_identification com.hxb_writer_stats in
+				let writer,close = create_writer com string_pool in
 				HxbWriter.write_module writer m;
-				let out = IO.output_string () in
-				HxbWriter.export writer out;
-				zip#add_entry (IO.close_out out) path;
+				let bytes = close () in
+				zip#add_entry bytes path;
 		end
 	| _ ->
 		()
 
 let check_hxb_output ctx actx =
 	let com = ctx.com in
+	let write_string_pool zip pool =
+		let writer,close = create_writer com (Some pool) in
+		let a = StringPool.finalize writer.cp in
+		HxbWriter.HxbWriter.write_string_pool writer STR a;
+		let bytes = close () in
+		zip#add_entry bytes ("StringPool.hxb");
+	in
 	let try_write path =
 		let t = Timer.timer ["generate";"hxb"] in
 		Path.mkdir_from_path path;
 		let zip = new Zip_output.zip_output path 6 in
+		let string_pool = StringPool.create () in
 		let export com =
 			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
+				Std.finally t (export_hxb com cc (Some string_pool) target zip) m
 			) com.modules;
 		in
 		Std.finally (fun () ->
@@ -71,6 +86,7 @@ let check_hxb_output ctx actx =
 		) (fun () ->
 			export com;
 			Option.may export (com.get_macros());
+			write_string_pool zip string_pool
 		) ()
 	in
 	begin match actx.hxb_out with

src/compiler/hxb/hxbLib.ml

@@ -17,6 +17,12 @@ class hxb_library file_path = object(self)
 			loaded <- true;
 			let close = Timer.timer ["hxblib";"read"] in
 			List.iter (function
+				| ({ Zip.filename = "StringPool.hxb"} as entry) ->
+					let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None in
+					let zip = Lazy.force zip in
+					let data = Bytes.unsafe_of_string (Zip.read_entry zip entry) in
+					ignore(reader#read (new HxbReaderApi.hxb_reader_api_null) data STR);
+					string_pool <- reader#get_string_pool
 				| ({ 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

src/compiler/hxb/hxbReader.ml

@@ -182,6 +182,12 @@ class hxb_reader
 			dump_backtrace();
 			error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
 
+	method get_string_pool =
+		if has_string_pool then
+			Some (string_pool)
+		else
+			None
+
 	(* Primitives *)
 
 	method read_i32 =

src/compiler/hxb/hxbReaderApi.ml

@@ -10,3 +10,15 @@ class virtual hxb_reader_api = object(self)
 	method virtual get_var_id : int -> int
 	method virtual read_expression_eagerly : tclass_field -> bool
 end
+
+class hxb_reader_api_null = object(self)
+	inherit hxb_reader_api
+
+	method make_module _ = assert false
+	method add_module _ = assert false
+	method resolve_type _ _ _ = assert false
+	method resolve_module _ = assert false
+	method basic_types = assert false
+	method get_var_id _ = assert false
+	method read_expression_eagerly _ = assert false
+end

src/compiler/hxb/hxbWriter.ml

@@ -2024,6 +2024,14 @@ module HxbWriter = struct
 		| TTypeDecl t ->
 			()
 
+	let write_string_pool writer kind a =
+		start_chunk writer kind;
+		Chunk.write_uleb128 writer.chunk a.StringDynArray.length;
+		StringDynArray.iter a (fun s ->
+			let b = Bytes.unsafe_of_string s in
+			Chunk.write_bytes_length_prefixed writer.chunk b;
+		)
+
 	let write_module writer (m : module_def) =
 		writer.current_module <- m;
 
@@ -2210,22 +2218,14 @@ module HxbWriter = struct
 		start_chunk writer EOF;
 		start_chunk writer EOM;
 
-		let finalize_string_pool kind a =
-			start_chunk writer kind;
-			Chunk.write_uleb128 writer.chunk a.StringDynArray.length;
-			StringDynArray.iter a (fun s ->
-				let b = Bytes.unsafe_of_string s in
-				Chunk.write_bytes_length_prefixed writer.chunk b;
-			)
-		in
 		if writer.has_own_string_pool then begin
 			let a = StringPool.finalize writer.cp in
-			finalize_string_pool STR a
+			write_string_pool writer STR a
 		end;
 		begin
 			let a = StringPool.finalize writer.docs in
 			if a.length > 0 then
-				finalize_string_pool DOC a
+				write_string_pool writer DOC a
 		end
 
 	let get_sorted_chunks writer =