From 04abc6efa56b93ac65bff9176213b49105b494ad Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 21 Jun 2024 22:59:30 +0200 Subject: [PATCH 1/6] start experimenting with extracting and rewriting embeds --- jscomp/bsc/rescript_compiler_main.ml | 3 + jscomp/common/js_config.ml | 2 + jscomp/common/js_config.mli | 3 + jscomp/core/js_embeds.ml | 39 ++++++++ jscomp/core/js_implementation.ml | 10 ++ jscomp/ext/literals.ml | 2 + jscomp/frontend/bs_builtin_ppx.ml | 5 + jscomp/frontend/bs_embed_lang.ml | 142 +++++++++++++++++++++++++++ 8 files changed, 206 insertions(+) create mode 100644 jscomp/core/js_embeds.ml create mode 100644 jscomp/frontend/bs_embed_lang.ml diff --git a/jscomp/bsc/rescript_compiler_main.ml b/jscomp/bsc/rescript_compiler_main.ml index 16e927f42b..a7515d6e06 100644 --- a/jscomp/bsc/rescript_compiler_main.ml +++ b/jscomp/bsc/rescript_compiler_main.ml @@ -223,6 +223,9 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array = "-I", string_list_add Clflags.include_dirs , "*internal* Add to the list of include directories" ; + "-embed", string_list_add Js_config.embeds , + "TODO: Explain." ; + "-w", string_call (Warnings.parse_options false), " Enable or disable warnings according to :\n\ + enable warnings in \n\ diff --git a/jscomp/common/js_config.ml b/jscomp/common/js_config.ml index 84f4e22f68..45f572e443 100644 --- a/jscomp/common/js_config.ml +++ b/jscomp/common/js_config.ml @@ -31,6 +31,8 @@ type jsx_mode = Classic | Automatic let no_version_header = ref false let directives = ref [] + +let embeds = ref [] let cross_module_inline = ref false let diagnose = ref false diff --git a/jscomp/common/js_config.mli b/jscomp/common/js_config.mli index 31855eaca7..bb4d75fc77 100644 --- a/jscomp/common/js_config.mli +++ b/jscomp/common/js_config.mli @@ -32,6 +32,9 @@ type jsx_mode = Classic | Automatic val no_version_header : bool ref (** set/get header *) +val embeds : string list ref +(** embeds *) + val directives : string list ref (** directives printed verbatims just after the version header *) diff --git a/jscomp/core/js_embeds.ml b/jscomp/core/js_embeds.ml new file mode 100644 index 0000000000..ab7bb549be --- /dev/null +++ b/jscomp/core/js_embeds.ml @@ -0,0 +1,39 @@ +let write_embeds ~extension_points ~output ast = + let content = ref [] in + let append item = content := item :: !content in + let extension (iterator : Ast_iterator.iterator) (ext : Parsetree.extension) = + (match ext with + | ( {txt}, + PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_loc; + pexp_desc = Pexp_constant (Pconst_string (contents, _)); + }, + _ ); + }; + ] ) + when extension_points |> List.mem txt -> + append (pexp_loc, txt, contents) + | _ -> ()); + Ast_iterator.default_iterator.extension iterator ext + in + let iterator = {Ast_iterator.default_iterator with extension} in + iterator.structure iterator ast; + match !content with + | [] -> () + | content -> + let text = + content + |> List.map (fun (loc, extensionName, contents) -> + Printf.sprintf "<<- item begin ->>\n%s\n%s\n%i:%i-%i:%i" + extensionName contents loc.Location.loc_start.pos_lnum + loc.loc_start.pos_cnum loc.loc_end.pos_lnum loc.loc_end.pos_cnum) + |> List.rev |> String.concat "\n\n" + in + let oc = open_out_bin output in + output_string oc text; + close_out oc \ No newline at end of file diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 9bf84c8264..99c1e46692 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -127,6 +127,15 @@ let no_export (rest : Parsetree.structure) : Parsetree.structure = ] | _ -> rest +let write_embeds outputprefix (ast : Parsetree.structure) = + if !Clflags.only_parse = false && !Js_config.binary_ast then ( + match !Js_config.embeds with + | [] -> () + | embeds -> Js_embeds.write_embeds ~extension_points:embeds + ~output:(outputprefix ^ Literals.suffix_embeds) + ast); + ast + let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = if !Clflags.only_parse = false then ( Js_config.all_module_aliases := @@ -180,6 +189,7 @@ let implementation ~parser ppf ?outputprefix fname = in Res_compmisc.init_path (); parser fname + |> write_embeds outputprefix |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Ml |> Ppx_entry.rewrite_implementation diff --git a/jscomp/ext/literals.ml b/jscomp/ext/literals.ml index 34163c0c6d..8e50c7894e 100644 --- a/jscomp/ext/literals.ml +++ b/jscomp/ext/literals.ml @@ -111,6 +111,8 @@ let suffix_cmti = ".cmti" let suffix_ast = ".ast" +let suffix_embeds = ".embeds" + let suffix_iast = ".iast" let suffix_d = ".d" diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index bf9bdb53ad..b27f52ea32 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -373,6 +373,11 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) : let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) : Parsetree.structure_item = + let str = + match !Js_config.embeds with + | [] -> str + | _ -> Bs_embed_lang.structure_item str + in match str.pstr_desc with | Pstr_type (rf, tdcls) (* [ {ptype_attributes} as tdcl ] *) -> Ast_tdcls.handle_tdcls_in_stru self str rf tdcls diff --git a/jscomp/frontend/bs_embed_lang.ml b/jscomp/frontend/bs_embed_lang.ml new file mode 100644 index 0000000000..4bebf97a65 --- /dev/null +++ b/jscomp/frontend/bs_embed_lang.ml @@ -0,0 +1,142 @@ +let should_transform name = !Js_config.embeds |> List.mem name + +let extract_extension str = + match String.split_on_char '.' str with + | ["generated"; tag] -> Some (tag, None) + | ["generated"; tag; fn_name] -> Some (tag, Some fn_name) + | [tag] -> Some (tag, None) + | [tag; fn_name] -> Some (tag, Some fn_name) + | _ -> None + +let transformed_count = Hashtbl.create 10 + +let increment_transformed_count (ext_name : string) = + match Hashtbl.find_opt transformed_count ext_name with + | None -> Hashtbl.add transformed_count ext_name 1 + | Some count -> Hashtbl.replace transformed_count ext_name (count + 1) + +let get_transformed_count ext_name = + match Hashtbl.find_opt transformed_count ext_name with + | None -> 0 + | Some count -> count + +type transformMode = LetBinding | ModuleBinding + +let make_lident ?fn_name ~extension_name ~transform_mode filename = + Longident.parse + (Printf.sprintf "%s__%s.M%i%s" + (if String.ends_with filename ~suffix:".res" then + Filename.(chop_suffix (basename filename) ".res") + else Filename.(chop_suffix (basename filename) ".resi")) + extension_name + (get_transformed_count extension_name) + (match (transform_mode, fn_name) with + | LetBinding, Some fn_name -> "." ^ fn_name + | LetBinding, None -> ".default" + | ModuleBinding, _ -> "")) + +let transform_expr expr = + match expr.Parsetree.pexp_desc with + | Pexp_extension + ( {txt = ext_name}, + PStr + [ + { + pstr_desc = + Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (_, _))}, _); + }; + ] ) + when should_transform ext_name -> ( + match extract_extension ext_name with + | None -> expr + | Some (extension_name, fn_name) -> + increment_transformed_count extension_name; + let loc = expr.pexp_loc in + let filename = loc.loc_start.pos_fname in + let lid = + make_lident ?fn_name ~extension_name ~transform_mode:LetBinding filename + in + Ast_helper.Exp.ident ~loc {txt = lid; loc}) + | _ -> expr + +let structure_item structure_item = + match structure_item.Parsetree.pstr_desc with + | Pstr_value + ( recFlag, + [ + ({ + pvb_expr = + {pexp_desc = Pexp_extension ({txt = ext_name}, _)} as expr; + } as valueBinding); + ] ) + when should_transform ext_name -> ( + match extract_extension ext_name with + | None -> structure_item + | Some _ -> + { + structure_item with + pstr_desc = + Pstr_value + (recFlag, [{valueBinding with pvb_expr = transform_expr expr}]); + }) + | Pstr_include + ({ + pincl_mod = + {pmod_desc = Pmod_extension ({txt = ext_name; loc}, _)} as pmod; + } as pincl) + when ext_name |> should_transform -> ( + match extract_extension ext_name with + | None -> structure_item + | Some (extension_name, _fn_name) -> + increment_transformed_count extension_name; + { + structure_item with + pstr_desc = + Pstr_include + { + pincl with + pincl_mod = + { + pmod with + pmod_desc = + Pmod_ident + { + txt = + make_lident loc.loc_start.pos_fname ~extension_name + ~transform_mode:ModuleBinding; + loc; + }; + }; + }; + }) + | Pstr_module + ({ + pmb_expr = + {pmod_desc = Pmod_extension ({txt = ext_name; loc}, _)} as pmod; + } as pmb) + when ext_name |> should_transform -> ( + match extract_extension ext_name with + | None -> structure_item + | Some (extension_name, _fn_name) -> + increment_transformed_count extension_name; + { + structure_item with + pstr_desc = + Pstr_module + { + pmb with + pmb_expr = + { + pmod with + pmod_desc = + Pmod_ident + { + txt = + make_lident loc.loc_start.pos_fname ~extension_name + ~transform_mode:ModuleBinding; + loc; + }; + }; + }; + }) + | _ -> structure_item From ca94ef44fe875c13756ce7e2fd0250827d69c638 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 27 Jun 2024 20:18:54 +0200 Subject: [PATCH 2/6] more work --- jscomp/core/js_embeds.ml | 5 +++-- jscomp/core/js_implementation.ml | 18 +++++++++++------- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/jscomp/core/js_embeds.ml b/jscomp/core/js_embeds.ml index ab7bb549be..729620dfe6 100644 --- a/jscomp/core/js_embeds.ml +++ b/jscomp/core/js_embeds.ml @@ -24,7 +24,7 @@ let write_embeds ~extension_points ~output ast = let iterator = {Ast_iterator.default_iterator with extension} in iterator.structure iterator ast; match !content with - | [] -> () + | [] -> false | content -> let text = content @@ -36,4 +36,5 @@ let write_embeds ~extension_points ~output ast = in let oc = open_out_bin output in output_string oc text; - close_out oc \ No newline at end of file + close_out oc; + true \ No newline at end of file diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 99c1e46692..9ece4985a8 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -127,13 +127,17 @@ let no_export (rest : Parsetree.structure) : Parsetree.structure = ] | _ -> rest -let write_embeds outputprefix (ast : Parsetree.structure) = - if !Clflags.only_parse = false && !Js_config.binary_ast then ( - match !Js_config.embeds with - | [] -> () - | embeds -> Js_embeds.write_embeds ~extension_points:embeds - ~output:(outputprefix ^ Literals.suffix_embeds) - ast); + let write_embeds outputprefix (ast : Parsetree.structure) = + (if !Clflags.only_parse = false && !Js_config.binary_ast then + let wrote_embeds = + match !Js_config.embeds with + | [] -> false + | embeds -> + Js_embeds.write_embeds ~extension_points:embeds + ~output:(outputprefix ^ Literals.suffix_embeds) + ast + in + if wrote_embeds then print_endline "1" else print_endline "0"); ast let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = From fdc5554e28451bdcc4bc2d466b46833509a71e9b Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 27 Jun 2024 20:33:24 +0200 Subject: [PATCH 3/6] adjust to new single file emission approach --- jscomp/frontend/bs_embed_lang.ml | 37 +++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 13 deletions(-) diff --git a/jscomp/frontend/bs_embed_lang.ml b/jscomp/frontend/bs_embed_lang.ml index 4bebf97a65..256dc0f59a 100644 --- a/jscomp/frontend/bs_embed_lang.ml +++ b/jscomp/frontend/bs_embed_lang.ml @@ -10,13 +10,21 @@ let extract_extension str = let transformed_count = Hashtbl.create 10 -let increment_transformed_count (ext_name : string) = - match Hashtbl.find_opt transformed_count ext_name with - | None -> Hashtbl.add transformed_count ext_name 1 - | Some count -> Hashtbl.replace transformed_count ext_name (count + 1) +let escaped_name_for_ext ?fn_name (ext_name : string) = + match fn_name with + | Some fn_name -> ext_name ^ "_" ^ fn_name + | None -> ext_name -let get_transformed_count ext_name = - match Hashtbl.find_opt transformed_count ext_name with +let increment_transformed_count ?fn_name (ext_name : string) = + let name = escaped_name_for_ext ?fn_name ext_name in + match Hashtbl.find_opt transformed_count name with + | None -> Hashtbl.add transformed_count name 1 + | Some count -> Hashtbl.replace transformed_count name (count + 1) + +let get_transformed_count ?fn_name ext_name = + match + Hashtbl.find_opt transformed_count (escaped_name_for_ext ?fn_name ext_name) + with | None -> 0 | Some count -> count @@ -24,12 +32,15 @@ type transformMode = LetBinding | ModuleBinding let make_lident ?fn_name ~extension_name ~transform_mode filename = Longident.parse - (Printf.sprintf "%s__%s.M%i%s" + (Printf.sprintf "%s__%s%s__M%i%s" (if String.ends_with filename ~suffix:".res" then Filename.(chop_suffix (basename filename) ".res") else Filename.(chop_suffix (basename filename) ".resi")) extension_name - (get_transformed_count extension_name) + (match fn_name with + | None -> "" + | Some fn_name -> "_" ^ fn_name) + (get_transformed_count ?fn_name extension_name) (match (transform_mode, fn_name) with | LetBinding, Some fn_name -> "." ^ fn_name | LetBinding, None -> ".default" @@ -50,7 +61,7 @@ let transform_expr expr = match extract_extension ext_name with | None -> expr | Some (extension_name, fn_name) -> - increment_transformed_count extension_name; + increment_transformed_count ?fn_name extension_name; let loc = expr.pexp_loc in let filename = loc.loc_start.pos_fname in let lid = @@ -87,8 +98,8 @@ let structure_item structure_item = when ext_name |> should_transform -> ( match extract_extension ext_name with | None -> structure_item - | Some (extension_name, _fn_name) -> - increment_transformed_count extension_name; + | Some (extension_name, fn_name) -> + increment_transformed_count ?fn_name extension_name; { structure_item with pstr_desc = @@ -117,8 +128,8 @@ let structure_item structure_item = when ext_name |> should_transform -> ( match extract_extension ext_name with | None -> structure_item - | Some (extension_name, _fn_name) -> - increment_transformed_count extension_name; + | Some (extension_name, fn_name) -> + increment_transformed_count ?fn_name extension_name; { structure_item with pstr_desc = From 464a4c7563f93a7b91a277e26d7833112884565e Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 6 Sep 2024 16:46:37 +0200 Subject: [PATCH 4/6] emit JSON file instead --- jscomp/core/js_embeds.ml | 127 +++++++++++++++------- jscomp/core/js_implementation.ml | 19 ++-- jscomp/ext/literals.ml | 2 +- jscomp/frontend/bs_embed_lang.ml | 181 ++++++++++++++----------------- 4 files changed, 178 insertions(+), 151 deletions(-) diff --git a/jscomp/core/js_embeds.ml b/jscomp/core/js_embeds.ml index 729620dfe6..81e3afced1 100644 --- a/jscomp/core/js_embeds.ml +++ b/jscomp/core/js_embeds.ml @@ -1,40 +1,91 @@ -let write_embeds ~extension_points ~output ast = - let content = ref [] in - let append item = content := item :: !content in - let extension (iterator : Ast_iterator.iterator) (ext : Parsetree.extension) = - (match ext with - | ( {txt}, - PStr - [ - { - pstr_desc = - Pstr_eval - ( { - pexp_loc; - pexp_desc = Pexp_constant (Pconst_string (contents, _)); - }, - _ ); - }; - ] ) - when extension_points |> List.mem txt -> - append (pexp_loc, txt, contents) - | _ -> ()); - Ast_iterator.default_iterator.extension iterator ext +let escape text = + let ln = String.length text in + let buf = Buffer.create ln in + let rec loop i = + if i < ln then ( + (match text.[i] with + | '\012' -> Buffer.add_string buf "\\f" + | '\\' -> Buffer.add_string buf "\\\\" + | '"' -> Buffer.add_string buf "\\\"" + | '\n' -> Buffer.add_string buf "\\n" + | '\b' -> Buffer.add_string buf "\\b" + | '\r' -> Buffer.add_string buf "\\r" + | '\t' -> Buffer.add_string buf "\\t" + | c -> Buffer.add_char buf c); + loop (i + 1)) in - let iterator = {Ast_iterator.default_iterator with extension} in - iterator.structure iterator ast; - match !content with - | [] -> false - | content -> - let text = - content - |> List.map (fun (loc, extensionName, contents) -> - Printf.sprintf "<<- item begin ->>\n%s\n%s\n%i:%i-%i:%i" - extensionName contents loc.Location.loc_start.pos_lnum - loc.loc_start.pos_cnum loc.loc_end.pos_lnum loc.loc_end.pos_cnum) - |> List.rev |> String.concat "\n\n" + loop 0; + Buffer.contents buf + +let write_text output text = + let oc = open_out_bin output in + output_string oc text; + close_out oc + +let write_embeds ~extension_points ~moduleFilename ~output ast = + match extension_points with + | [] -> write_text output "[]" + | extension_points -> ( + let content = ref [] in + let append item = content := item :: !content in + let extension (iterator : Ast_iterator.iterator) (ext : Parsetree.extension) + = + (match ext with + | ( {txt}, + PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_loc; + pexp_desc = Pexp_constant (Pconst_string (contents, _)); + }, + _ ); + }; + ] ) + when extension_points |> List.mem txt -> + append (pexp_loc, txt, contents) + | _ -> ()); + Ast_iterator.default_iterator.extension iterator ext in - let oc = open_out_bin output in - output_string oc text; - close_out oc; - true \ No newline at end of file + let iterator = {Ast_iterator.default_iterator with extension} in + iterator.structure iterator ast; + match !content with + | [] -> write_text output "[]" + | content -> + let counts = Hashtbl.create 10 in + let text = + "[\n" + ^ (content |> List.rev + |> List.map (fun (loc, extensionName, contents) -> + let current_tag_count = + match Hashtbl.find_opt counts extensionName with + | None -> 0 + | Some count -> count + in + let tag_count = current_tag_count + 1 in + Hashtbl.replace counts extensionName tag_count; + + let target_file_name = + Printf.sprintf "%s.res" + (Bs_embed_lang.make_embed_target_module_name + ~moduleFilename ~extensionName ~tag_count) + in + Printf.sprintf + " {\n\ + \ \"tag\": \"%s\",\n\ + \ \"filename\": \"%s\",\n\ + \ \"contents\": \"%s\",\n\ + \ \"loc\": {\"start\": {\"line\": %s, \"col\": %s}, \ + \"end\": {\"line\": %s, \"col\": %s}}\n\ + \ }" (escape extensionName) target_file_name + (escape contents) + (loc.Location.loc_start.pos_lnum |> string_of_int) + (loc.loc_start.pos_cnum |> string_of_int) + (loc.loc_end.pos_lnum |> string_of_int) + (loc.loc_end.pos_cnum |> string_of_int)) + |> String.concat ",\n") + ^ "\n]" + in + write_text output text) \ No newline at end of file diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 9ece4985a8..c66543625d 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -127,18 +127,13 @@ let no_export (rest : Parsetree.structure) : Parsetree.structure = ] | _ -> rest - let write_embeds outputprefix (ast : Parsetree.structure) = - (if !Clflags.only_parse = false && !Js_config.binary_ast then - let wrote_embeds = - match !Js_config.embeds with - | [] -> false - | embeds -> - Js_embeds.write_embeds ~extension_points:embeds - ~output:(outputprefix ^ Literals.suffix_embeds) - ast - in - if wrote_embeds then print_endline "1" else print_endline "0"); - ast +let write_embeds outputprefix (ast : Parsetree.structure) = + if !Clflags.only_parse = false && !Js_config.binary_ast then + Js_embeds.write_embeds ~moduleFilename:outputprefix + ~extension_points:!Js_config.embeds + ~output:(outputprefix ^ Literals.suffix_embeds) + ast; + ast let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) = if !Clflags.only_parse = false then ( diff --git a/jscomp/ext/literals.ml b/jscomp/ext/literals.ml index 8e50c7894e..24e3c53a59 100644 --- a/jscomp/ext/literals.ml +++ b/jscomp/ext/literals.ml @@ -111,7 +111,7 @@ let suffix_cmti = ".cmti" let suffix_ast = ".ast" -let suffix_embeds = ".embeds" +let suffix_embeds = ".embeds.json" let suffix_iast = ".iast" diff --git a/jscomp/frontend/bs_embed_lang.ml b/jscomp/frontend/bs_embed_lang.ml index 256dc0f59a..9e47728ad3 100644 --- a/jscomp/frontend/bs_embed_lang.ml +++ b/jscomp/frontend/bs_embed_lang.ml @@ -1,12 +1,10 @@ let should_transform name = !Js_config.embeds |> List.mem name -let extract_extension str = - match String.split_on_char '.' str with - | ["generated"; tag] -> Some (tag, None) - | ["generated"; tag; fn_name] -> Some (tag, Some fn_name) - | [tag] -> Some (tag, None) - | [tag; fn_name] -> Some (tag, Some fn_name) - | _ -> None +let make_embed_target_module_name ~moduleFilename ~extensionName ~tag_count = + Printf.sprintf "%s__%s_%i" + (String.capitalize_ascii moduleFilename) + (String.map (fun c -> if c = '.' then '_' else c) extensionName) + tag_count let transformed_count = Hashtbl.create 10 @@ -21,35 +19,32 @@ let increment_transformed_count ?fn_name (ext_name : string) = | None -> Hashtbl.add transformed_count name 1 | Some count -> Hashtbl.replace transformed_count name (count + 1) -let get_transformed_count ?fn_name ext_name = - match - Hashtbl.find_opt transformed_count (escaped_name_for_ext ?fn_name ext_name) - with +let get_transformed_count ext_name = + match Hashtbl.find_opt transformed_count ext_name with | None -> 0 | Some count -> count type transformMode = LetBinding | ModuleBinding -let make_lident ?fn_name ~extension_name ~transform_mode filename = +let make_lident ~extension_name ~transform_mode filename = + let module_name = + if String.ends_with filename ~suffix:".res" then + Filename.(chop_suffix (basename filename) ".res") + else Filename.(chop_suffix (basename filename) ".resi") + in Longident.parse - (Printf.sprintf "%s__%s%s__M%i%s" - (if String.ends_with filename ~suffix:".res" then - Filename.(chop_suffix (basename filename) ".res") - else Filename.(chop_suffix (basename filename) ".resi")) - extension_name - (match fn_name with - | None -> "" - | Some fn_name -> "_" ^ fn_name) - (get_transformed_count ?fn_name extension_name) - (match (transform_mode, fn_name) with - | LetBinding, Some fn_name -> "." ^ fn_name - | LetBinding, None -> ".default" - | ModuleBinding, _ -> "")) + (Printf.sprintf "%s%s" + (make_embed_target_module_name ~moduleFilename:module_name + ~extensionName:extension_name + ~tag_count:(get_transformed_count extension_name)) + (match transform_mode with + | LetBinding -> ".default" + | ModuleBinding -> "")) let transform_expr expr = match expr.Parsetree.pexp_desc with | Pexp_extension - ( {txt = ext_name}, + ( {txt = extension_name}, PStr [ { @@ -57,17 +52,12 @@ let transform_expr expr = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (_, _))}, _); }; ] ) - when should_transform ext_name -> ( - match extract_extension ext_name with - | None -> expr - | Some (extension_name, fn_name) -> - increment_transformed_count ?fn_name extension_name; - let loc = expr.pexp_loc in - let filename = loc.loc_start.pos_fname in - let lid = - make_lident ?fn_name ~extension_name ~transform_mode:LetBinding filename - in - Ast_helper.Exp.ident ~loc {txt = lid; loc}) + when should_transform extension_name -> + increment_transformed_count extension_name; + let loc = expr.pexp_loc in + let filename = loc.loc_start.pos_fname in + let lid = make_lident ~extension_name ~transform_mode:LetBinding filename in + Ast_helper.Exp.ident ~loc {txt = lid; loc} | _ -> expr let structure_item structure_item = @@ -77,77 +67,68 @@ let structure_item structure_item = [ ({ pvb_expr = - {pexp_desc = Pexp_extension ({txt = ext_name}, _)} as expr; + {pexp_desc = Pexp_extension ({txt = extension_name}, _)} as expr; } as valueBinding); ] ) - when should_transform ext_name -> ( - match extract_extension ext_name with - | None -> structure_item - | Some _ -> - { - structure_item with - pstr_desc = - Pstr_value - (recFlag, [{valueBinding with pvb_expr = transform_expr expr}]); - }) + when should_transform extension_name -> + { + structure_item with + pstr_desc = + Pstr_value + (recFlag, [{valueBinding with pvb_expr = transform_expr expr}]); + } | Pstr_include ({ pincl_mod = - {pmod_desc = Pmod_extension ({txt = ext_name; loc}, _)} as pmod; + {pmod_desc = Pmod_extension ({txt = extension_name; loc}, _)} as pmod; } as pincl) - when ext_name |> should_transform -> ( - match extract_extension ext_name with - | None -> structure_item - | Some (extension_name, fn_name) -> - increment_transformed_count ?fn_name extension_name; - { - structure_item with - pstr_desc = - Pstr_include - { - pincl with - pincl_mod = - { - pmod with - pmod_desc = - Pmod_ident - { - txt = - make_lident loc.loc_start.pos_fname ~extension_name - ~transform_mode:ModuleBinding; - loc; - }; - }; - }; - }) + when should_transform extension_name -> + increment_transformed_count extension_name; + { + structure_item with + pstr_desc = + Pstr_include + { + pincl with + pincl_mod = + { + pmod with + pmod_desc = + Pmod_ident + { + txt = + make_lident loc.loc_start.pos_fname ~extension_name + ~transform_mode:ModuleBinding; + loc; + }; + }; + }; + } | Pstr_module ({ pmb_expr = - {pmod_desc = Pmod_extension ({txt = ext_name; loc}, _)} as pmod; + {pmod_desc = Pmod_extension ({txt = extension_name; loc}, _)} as pmod; } as pmb) - when ext_name |> should_transform -> ( - match extract_extension ext_name with - | None -> structure_item - | Some (extension_name, fn_name) -> - increment_transformed_count ?fn_name extension_name; - { - structure_item with - pstr_desc = - Pstr_module - { - pmb with - pmb_expr = - { - pmod with - pmod_desc = - Pmod_ident - { - txt = - make_lident loc.loc_start.pos_fname ~extension_name - ~transform_mode:ModuleBinding; - loc; - }; - }; - }; - }) + when should_transform extension_name -> + increment_transformed_count extension_name; + { + structure_item with + pstr_desc = + Pstr_module + { + pmb with + pmb_expr = + { + pmod with + pmod_desc = + Pmod_ident + { + txt = + make_lident loc.loc_start.pos_fname ~extension_name + ~transform_mode:ModuleBinding; + loc; + }; + }; + }; + } | _ -> structure_item From f6d7c9b0b24e792b889eb17ad43f03adac3a2bbf Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Fri, 6 Sep 2024 16:50:06 +0200 Subject: [PATCH 5/6] no camelCase --- jscomp/core/js_embeds.ml | 14 +++++++------- jscomp/core/js_implementation.ml | 2 +- jscomp/frontend/bs_embed_lang.ml | 10 +++++----- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/jscomp/core/js_embeds.ml b/jscomp/core/js_embeds.ml index 81e3afced1..7f4548e367 100644 --- a/jscomp/core/js_embeds.ml +++ b/jscomp/core/js_embeds.ml @@ -22,7 +22,7 @@ let write_text output text = output_string oc text; close_out oc -let write_embeds ~extension_points ~moduleFilename ~output ast = +let write_embeds ~extension_points ~module_filename ~output ast = match extension_points with | [] -> write_text output "[]" | extension_points -> ( @@ -58,19 +58,19 @@ let write_embeds ~extension_points ~moduleFilename ~output ast = let text = "[\n" ^ (content |> List.rev - |> List.map (fun (loc, extensionName, contents) -> + |> List.map (fun (loc, extension_name, contents) -> let current_tag_count = - match Hashtbl.find_opt counts extensionName with + match Hashtbl.find_opt counts extension_name with | None -> 0 | Some count -> count in let tag_count = current_tag_count + 1 in - Hashtbl.replace counts extensionName tag_count; + Hashtbl.replace counts extension_name tag_count; let target_file_name = Printf.sprintf "%s.res" (Bs_embed_lang.make_embed_target_module_name - ~moduleFilename ~extensionName ~tag_count) + ~module_filename ~extension_name ~tag_count) in Printf.sprintf " {\n\ @@ -79,7 +79,7 @@ let write_embeds ~extension_points ~moduleFilename ~output ast = \ \"contents\": \"%s\",\n\ \ \"loc\": {\"start\": {\"line\": %s, \"col\": %s}, \ \"end\": {\"line\": %s, \"col\": %s}}\n\ - \ }" (escape extensionName) target_file_name + \ }" (escape extension_name) target_file_name (escape contents) (loc.Location.loc_start.pos_lnum |> string_of_int) (loc.loc_start.pos_cnum |> string_of_int) @@ -88,4 +88,4 @@ let write_embeds ~extension_points ~moduleFilename ~output ast = |> String.concat ",\n") ^ "\n]" in - write_text output text) \ No newline at end of file + write_text output text) diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index c66543625d..d36be0e42b 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -129,7 +129,7 @@ let no_export (rest : Parsetree.structure) : Parsetree.structure = let write_embeds outputprefix (ast : Parsetree.structure) = if !Clflags.only_parse = false && !Js_config.binary_ast then - Js_embeds.write_embeds ~moduleFilename:outputprefix + Js_embeds.write_embeds ~module_filename:outputprefix ~extension_points:!Js_config.embeds ~output:(outputprefix ^ Literals.suffix_embeds) ast; diff --git a/jscomp/frontend/bs_embed_lang.ml b/jscomp/frontend/bs_embed_lang.ml index 9e47728ad3..4e0bab4337 100644 --- a/jscomp/frontend/bs_embed_lang.ml +++ b/jscomp/frontend/bs_embed_lang.ml @@ -1,9 +1,9 @@ let should_transform name = !Js_config.embeds |> List.mem name -let make_embed_target_module_name ~moduleFilename ~extensionName ~tag_count = +let make_embed_target_module_name ~module_filename ~extension_name ~tag_count = Printf.sprintf "%s__%s_%i" - (String.capitalize_ascii moduleFilename) - (String.map (fun c -> if c = '.' then '_' else c) extensionName) + (String.capitalize_ascii module_filename) + (String.map (fun c -> if c = '.' then '_' else c) extension_name) tag_count let transformed_count = Hashtbl.create 10 @@ -34,8 +34,8 @@ let make_lident ~extension_name ~transform_mode filename = in Longident.parse (Printf.sprintf "%s%s" - (make_embed_target_module_name ~moduleFilename:module_name - ~extensionName:extension_name + (make_embed_target_module_name ~module_filename:module_name + ~extension_name ~tag_count:(get_transformed_count extension_name)) (match transform_mode with | LetBinding -> ".default" From 4a958289c0cacb48b031fa275152fe7066519c17 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 19 Sep 2024 07:35:57 +0200 Subject: [PATCH 6/6] fix locations --- jscomp/core/js_embeds.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/jscomp/core/js_embeds.ml b/jscomp/core/js_embeds.ml index 7f4548e367..4ba895dca4 100644 --- a/jscomp/core/js_embeds.ml +++ b/jscomp/core/js_embeds.ml @@ -82,9 +82,9 @@ let write_embeds ~extension_points ~module_filename ~output ast = \ }" (escape extension_name) target_file_name (escape contents) (loc.Location.loc_start.pos_lnum |> string_of_int) - (loc.loc_start.pos_cnum |> string_of_int) + ((loc.loc_start.pos_cnum - loc.loc_start.pos_bol) |> string_of_int) (loc.loc_end.pos_lnum |> string_of_int) - (loc.loc_end.pos_cnum |> string_of_int)) + ((loc.loc_end.pos_cnum - loc.loc_end.pos_bol) |> string_of_int)) |> String.concat ",\n") ^ "\n]" in