Skip to content

Commit

Permalink
[hxb] simplify string pool handling/config
Browse files Browse the repository at this point in the history
  • Loading branch information
kLabz committed Feb 13, 2024
1 parent 16a6622 commit 9479038
Show file tree
Hide file tree
Showing 2 changed files with 11 additions and 17 deletions.
20 changes: 8 additions & 12 deletions src/compiler/generate.ml
Original file line number Diff line number Diff line change
Expand Up @@ -93,34 +93,30 @@ let check_hxb_output ctx config =
zip#close;
t()
) (fun () ->
let string_pool = if config.use_string_pool then Some (StringPool.create ()) else None in
let string_pool = if config.share_string_pool then Some (StringPool.create ()) else None in
if config.target_config.generate then begin
export com config.target_config string_pool;

if config.use_string_pool && not config.share_string_pool then
write_string_pool config.target_config zip "StringPool.hxb" (Option.get string_pool)
end;

if config.macro_config.generate then begin
match com.get_macros() with
| Some mcom ->
let string_pool = if not config.share_string_pool then Some (StringPool.create ()) else string_pool in
let use_separate_pool = config.share_string_pool && from_cache in
let string_pool = if use_separate_pool then Some (StringPool.create ()) else string_pool in
export mcom config.macro_config string_pool;

if config.use_string_pool && not config.share_string_pool then
write_string_pool config.macro_config zip "StringPool.macro.hxb" (Option.get string_pool)
if use_separate_pool then write_string_pool config.macro_config zip "StringPool.macro.hxb" (Option.get string_pool)
| _ ->
()
end;

if config.use_string_pool && config.share_string_pool then
(* Technically this should be a common config, but it won't be used anyway... *)
if config.share_string_pool then
write_string_pool config.target_config zip "StringPool.hxb" (Option.get string_pool);
) ()
in
try
let from_cache = not (config.use_string_pool && config.share_string_pool && config.target_config.generate && config.macro_config.generate) in
try try_write from_cache with Abort -> try_write false
(* This Abort case shouldn't happen, unless some modules are not stored in hxb cache (which should not be the case currently) *)
if ctx.comm.is_server then try try_write true with Abort -> try_write false
else try_write false
with Sys_error s ->
CompilationContext.error ctx (Printf.sprintf "Could not write to %s: %s" config.archive_path s) null_pos

Expand Down
8 changes: 3 additions & 5 deletions src/compiler/hxb/hxbWriterConfig.ml
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,7 @@ type writer_target_config = {

type t = {
mutable archive_path : string;
mutable use_string_pool : bool;
mutable share_string_pool : bool; (* Note: ignored if use_string_pool = false *)
mutable share_string_pool : bool;
target_config : writer_target_config;
macro_config : writer_target_config;
}
Expand All @@ -27,8 +26,7 @@ let create_target_config () = {

let create () = {
archive_path = "";
use_string_pool = true; (* Do we want this as default? *)
share_string_pool = false; (* Note: can't reuse hxb cache if true *)
share_string_pool = true; (* Do we want this as default? *)
target_config = create_target_config ();
macro_config = create_target_config ()
}
Expand Down Expand Up @@ -119,4 +117,4 @@ let process_argument file =
| _ ->
config.archive_path <- file;
end;
Some config
Some config

0 comments on commit 9479038

Please sign in to comment.