diff --git a/CHANGES.md b/CHANGES.md index b5ba731b89..761ee523db 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,10 @@ # dev ## Features/Changes +* Compiler: experimental ECMAScript module output: `js_of_ocaml compile --esm` + and `build-runtime --esm` emit ES modules (units import the runtime instead + of reading `globalThis.jsoo_runtime`); `js_of_ocaml link --esm` links them + into an entry module, or a single tree-shaken module with `--bundle` (#2402) * Lib: add `WebGL2` — bindings to the WebGL2 rendering context. The context inherits every method and constant of `WebGL`, and adds the WebGL2 objects (vertex array objects, queries, samplers, syncs, transform feedback), 3D and diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 7f62ae614e..16b2926e44 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -63,6 +63,8 @@ type t = ; params : (string * string) list ; static_env : (string * string) list ; wrap_with_fun : [ `Iife | `Named of string | `Anonymous ] + ; esm : bool + ; esm_runtime_path : string ; target_env : Target_env.t ; shape_files : string list ; (* toplevel *) @@ -100,6 +102,17 @@ let wrap_with_fun_conv = in Arg.conv (conv, printer) +let esm_arg = + let doc = "Experimental: emit an ECMAScript module instead of a script." in + Arg.(value & flag & info [ "esm" ] ~doc) + +let esm_runtime_path_arg = + let doc = + "Experimental: module specifier used by separately compiled units to import the \ + runtime (only meaningful together with '--esm')." + in + Arg.(value & opt string "./runtime.js" & info [ "esm-runtime-path" ] ~docv:"PATH" ~doc) + let toplevel_section = "OPTIONS (TOPLEVEL)" let options = @@ -292,6 +305,8 @@ let options = toplevel export_file wrap_with_fun + esm + esm_runtime_path include_dirs fs_files fs_output @@ -380,6 +395,8 @@ let options = ; profile ; static_env ; wrap_with_fun + ; esm + ; esm_runtime_path ; dynlink ; linkall ; target_env @@ -413,6 +430,8 @@ let options = $ toplevel $ export_file $ wrap_with_function + $ esm_arg + $ esm_runtime_path_arg $ include_dirs $ fs_files $ fs_output @@ -577,6 +596,8 @@ let options_runtime_only = set_param set_env wrap_with_fun + esm + esm_runtime_path fs_files fs_output fs_external @@ -645,6 +666,8 @@ let options_runtime_only = ; profile = None ; static_env ; wrap_with_fun + ; esm + ; esm_runtime_path ; dynlink = false ; linkall = false ; target_env @@ -676,6 +699,8 @@ let options_runtime_only = $ set_param $ set_env $ wrap_with_function + $ esm_arg + $ esm_runtime_path_arg $ fs_files $ fs_output $ fs_external diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index 08899c98ae..b7a3374fea 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -36,6 +36,8 @@ type t = | `Named of string | `Anonymous ] + ; esm : bool + ; esm_runtime_path : string ; target_env : Target_env.t ; shape_files : string list ; (* toplevel *) diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index b5ba6c672d..befac85d85 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -144,6 +144,8 @@ let run ; params ; static_env ; wrap_with_fun + ; esm + ; esm_runtime_path ; dynlink ; linkall ; target_env @@ -268,6 +270,15 @@ let run ~link output_file = if check_sourcemap then check_debug one; + let esm : Driver.esm option = + if esm + then + (* Standalone programs and the runtime inline the runtime code; only + separately compiled units import it. *) + Some + { Driver.runtime_import = (if standalone then None else Some esm_runtime_path) } + else None + in let init_pseudo_fs = fs_external && standalone in let sm, shapes = match output_file with @@ -282,6 +293,7 @@ let run let code = Code.prepend one.code instr in Driver.f ~standalone + ?esm ~shapes ?profile ~link @@ -306,6 +318,7 @@ let run let res = Driver.f ~standalone + ?esm ~shapes ?profile ~link diff --git a/compiler/bin-js_of_ocaml/link.ml b/compiler/bin-js_of_ocaml/link.ml index 3a05baa0d2..ea6aa3b634 100644 --- a/compiler/bin-js_of_ocaml/link.ml +++ b/compiler/bin-js_of_ocaml/link.ml @@ -30,6 +30,9 @@ type t = ; linkall : bool ; mklib : bool ; dynlink : bool + ; esm : bool + ; bundle : bool + ; no_tree_shake : bool } let options = @@ -82,6 +85,24 @@ let options = let doc = "Enable dynlink/toplevel support." in Arg.(value & flag & info [ "dynlink"; "toplevel" ] ~doc) in + let esm = + let doc = + "Experimental: link ECMAScript modules produced by 'js_of_ocaml --esm'. The output \ + is an entry module importing every file in order; with '--bundle' the modules are \ + merged into a single self-contained module instead." + in + Arg.(value & flag & info [ "esm" ] ~doc) + in + let bundle = + let doc = + "Experimental: bundle the modules into a single module (requires '--esm')." + in + Arg.(value & flag & info [ "bundle" ] ~doc) + in + let no_tree_shake = + let doc = "Experimental: disable tree shaking when bundling." in + Arg.(value & flag & info [ "no-tree-shake" ] ~doc) + in let build_t common no_sourcemap @@ -94,7 +115,10 @@ let options = js_files linkall mklib - dynlink = + dynlink + esm + bundle + no_tree_shake = let chop_extension s = try Filename.chop_extension s with Invalid_argument _ -> s in let source_map = if (not no_sourcemap) && (sourcemap || sourcemap_inline_in_js) @@ -129,6 +153,9 @@ let options = ; linkall ; mklib ; dynlink + ; esm + ; bundle + ; no_tree_shake } in let t = @@ -145,10 +172,286 @@ let options = $ js_files $ linkall $ mklib - $ dynlink) + $ dynlink + $ esm + $ bundle + $ no_tree_shake) in Term.ret t +(* ES module linking (experimental). Paths are used as module identifiers: + normalize them so that resolved import specifiers and command-line paths + agree on separators and [.]/[..] components. *) +let normalize_path path = + let path = + if Sys.win32 + then String.map path ~f:(fun c -> if Char.equal c '\\' then '/' else c) + else path + in + let parts = String.split_on_char ~sep:'/' path in + let rec normalize acc = function + | [] -> List.rev acc + | "." :: rest -> normalize acc rest + | ".." :: rest -> ( + match acc with + | (".." | "") :: _ | [] -> normalize (".." :: acc) rest + | _ :: acc' -> normalize acc' rest) + | part :: rest -> normalize (part :: acc) rest + in + String.concat ~sep:"/" (normalize [] parts) + +let absolute_path path = + normalize_path + (if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path else path) + +(* The specifier importing [path] from a module located in [dir]. *) +let relative_specifier ~dir path = + let rec strip_common_prefix l1 l2 = + match l1, l2 with + | x :: r1, y :: r2 when String.equal x y -> strip_common_prefix r1 r2 + | _ -> l1, l2 + in + let dir_parts = String.split_on_char ~sep:'/' (absolute_path dir) in + let path_parts = String.split_on_char ~sep:'/' (absolute_path path) in + let dir_rest, path_rest = strip_common_prefix dir_parts path_parts in + let ups = List.map dir_rest ~f:(fun _ -> "..") in + let parts = + match ups with + | [] -> "." :: path_rest + | _ -> ups @ path_rest + in + String.concat ~sep:"/" parts + +(* A compiled .js file may hold several compilation units (a .cma): each unit + starts with a '//# unitInfo: Provides:' line. Such a file is a container, + not a valid module by itself — units may declare the same names (helpers, + import bindings) — and is only meant to be consumed by the linker, which + splits it back into one module per unit. *) +let split_units content = + let unit_start = "//# unitInfo: Provides:" in + let lines = String.split_on_char ~sep:'\n' content in + let finish name acc chunks = + match acc with + | [] -> chunks + | _ -> (name, String.concat ~sep:"\n" (List.rev acc)) :: chunks + in + let rec loop name acc chunks = function + | [] -> List.rev (finish name acc chunks) + | line :: rest -> + if String.starts_with ~prefix:unit_start line + then + let unit_name = + String.trim + (String.sub + line + ~pos:(String.length unit_start) + ~len:(String.length line - String.length unit_start)) + in + (* An empty 'Provides:' is file-level metadata (e.g. the runtime, + which provides no OCaml unit), not a unit boundary. *) + if String.is_empty unit_name + then loop name (line :: acc) chunks rest + else loop (Some unit_name) [ line ] (finish name acc chunks) rest + else loop name (line :: acc) chunks rest + in + match loop None [] [] lines with + | (None, _header) :: (_ :: _ as units) -> units + | units -> units + +(* Linker inputs: plain modules (no unit information, e.g. the runtime) and + compilation units. Units reference each other with [import X from + "./X.js"] specifiers where [X] is a unit name: the linker resolves those + by name, wherever the unit actually comes from. *) +type input = + | Plain of string (* path *) + | Unit of + { name : string + ; file : string (* file the unit comes from *) + ; content : string + ; whole_file : bool (* the unit is the whole file, not a chunk *) + } + +let read_inputs files = + let inputs = + List.concat_map files ~f:(fun file -> + let content = Fs.read_file file in + match split_units content with + | [] | [ (None, _) ] -> [ Plain file ] + | [ (Some name, _) ] -> [ Unit { name; file; content; whole_file = true } ] + | units -> + List.map units ~f:(fun (name, chunk) -> + match name with + | Some name -> Unit { name; file; content = chunk; whole_file = false } + | None -> assert false)) + in + let (_ : StringSet.t) = + List.fold_left inputs ~init:StringSet.empty ~f:(fun acc input -> + match input with + | Plain _ -> acc + | Unit { name; _ } -> + if StringSet.mem name acc + then failwith (Printf.sprintf "unit '%s' provided by several files" name) + else StringSet.add name acc) + in + inputs + +(* The unit name of an [import X from "./X.js"] specifier. *) +let unit_of_specifier spec = + match String.drop_prefix ~prefix:"./" spec with + | Some rest when String.ends_with ~suffix:".js" rest && not (String.contains rest '/') + -> Some (String.sub rest ~pos:0 ~len:(String.length rest - 3)) + | Some _ | None -> None + +let parse_string ~filename content = + let lexer = Parse_js.Lexer.of_string ~filename content in + Parse_js.parse `Module lexer + +(* Rebase the relative import specifiers of a unit extracted from a file in + [src_dir] so that the unit can live in [dst_dir]. Imports of other units + are left alone: all units end up next to each other in [dst_dir]. *) +let rebase_imports ~unit_names ~src_dir ~dst_dir program = + List.map program ~f:(fun ((stmt : Javascript.statement), loc) -> + match stmt with + | Import (({ from = Utf8_string.Utf8 spec; _ } as import), pi) + when (String.starts_with ~prefix:"./" spec + || String.starts_with ~prefix:"../" spec) + && + match unit_of_specifier spec with + | Some unit -> not (StringSet.mem unit unit_names) + | None -> true -> + let target = normalize_path (Filename.concat src_dir spec) in + let spec = relative_specifier ~dir:dst_dir target in + ( Javascript.Import ({ import with from = Utf8_string.of_string_exn spec }, pi) + , loc ) + | _ -> stmt, loc) + +let print_program output program = + let pp = Pretty_print.to_out_channel output in + Driver.configure pp; + let program = Driver.name_variables program in + let (_ : Source_map.info) = Js_output.program pp program in + () + +let link_esm ~output_file ~files ~bundle ~tree_shake ~linkall = + let output_dir = + match output_file with + | Some file -> Filename.dirname file + | None -> "." + in + let with_output f = + match output_file with + | None -> f stdout + | Some file -> Filename.gen_file file f + in + let inputs = read_inputs files in + let unit_names = + List.fold_left inputs ~init:StringSet.empty ~f:(fun acc input -> + match input with + | Plain _ -> acc + | Unit { name; _ } -> StringSet.add name acc) + in + (* Units coming from a multi-unit container (.cma.js) behave like archive + members: they are linked only when another linked unit references them + (through an import), matching ocamlc. [--linkall] links them all. Units + given as standalone files and plain modules are always linked. *) + let root = function + | Plain _ -> true + | Unit { whole_file; _ } -> whole_file || linkall + in + if not bundle + then + (* Emit an entry module importing each root in link order. ES semantics + guarantee the modules are evaluated in declaration order (post-order + depth-first), and each unit's own imports evaluate its dependencies + first. Units import each other as siblings ("./X.js"), so they must + all live in one directory: materialize them into the entry's + directory, except unit files already there under their unit name. *) + let specifiers = + List.filter_map inputs ~f:(fun input -> + match input with + | Plain file -> Some (relative_specifier ~dir:output_dir file) + | Unit { name; file; content; whole_file } -> + let spec = "./" ^ name ^ ".js" in + let in_place = + whole_file + && String.equal + (absolute_path file) + (absolute_path (Filename.concat output_dir (name ^ ".js"))) + in + if not in_place + then begin + let src_dir = Filename.dirname (absolute_path file) in + let program = + parse_string ~filename:file content + |> rebase_imports ~unit_names ~src_dir ~dst_dir:output_dir + in + Filename.gen_file + (Filename.concat output_dir (name ^ ".js")) + (fun out -> print_program out program) + end; + if root input then Some spec else None) + in + with_output (fun output -> + List.iter specifiers ~f:(fun spec -> Printf.fprintf output "import %S;\n" spec)) + else + (* Bundle in memory: each unit becomes a module with a synthetic id + ('!'); [Filename.dirname] still resolves their relative + imports against the file's directory, and imports of other units are + resolved by unit name. *) + let sections = + List.map inputs ~f:(fun input -> + match input with + | Plain file -> absolute_path file, None, Fs.read_file file + | Unit { name; file; content; whole_file } -> + let id = + if whole_file + then absolute_path file + else Printf.sprintf "%s!%s" (absolute_path file) name + in + id, Some name, content) + in + let sources = String.Hashtbl.create 64 in + let unit_ids = String.Hashtbl.create 64 in + List.iter sections ~f:(fun (id, name, content) -> + String.Hashtbl.add sources id content; + Option.iter name ~f:(fun name -> String.Hashtbl.add unit_ids name id)); + let parse path = + match String.Hashtbl.find_opt sources path with + | Some content -> parse_string ~filename:path content + | None -> parse_string ~filename:path (Fs.read_file path) + in + let resolve ~from specifier = + match unit_of_specifier specifier with + | Some unit when String.Hashtbl.mem unit_ids unit -> + String.Hashtbl.find_opt unit_ids unit + | Some _ | None -> + if + Filename.is_relative specifier + && (String.starts_with ~prefix:"./" specifier + || String.starts_with ~prefix:"../" specifier) + then + let dir = Filename.dirname from in + let resolved = normalize_path (Filename.concat dir specifier) in + if Sys.file_exists resolved then Some resolved else None + else None + in + let entry_points = + List.filter_map (List.combine inputs sections) ~f:(fun (input, (id, _, _)) -> + if root input then Some id else None) + in + let program = Esm_bundle.bundle_modules ~parse ~resolve ~entry_points ~tree_shake in + (* The bundle of a linked program is itself a program: drop the export + statements the bundler generates for entry modules (each entry unit + exports its module block as [default]). *) + let program = + List.filter program ~f:(fun (stmt, _) -> + match (stmt : Javascript.statement) with + | Export _ -> false + | _ -> true) + in + let program = Driver.simplify_js program in + with_output (fun output -> print_program output program) + let f { common ; output_file @@ -157,6 +460,9 @@ let f ; js_files ; linkall ; mklib + ; esm + ; bundle + ; no_tree_shake ; dynlink = _ (* TODO: when [dynlink] (i.e. --dynlink/--toplevel) is false, the linker @@ -169,19 +475,23 @@ let f Config.set_target `JavaScript; Jsoo_cmdline.Arg.eval common; Linker.reset (); - let with_output f = - match output_file with - | None -> f stdout - | Some file -> Filename.gen_file file f - in - with_output (fun output -> - Link_js.link - ~output - ~linkall - ~mklib - ~files:js_files - ~source_map - ~resolve_sourcemap_url) + if esm + then + link_esm ~output_file ~files:js_files ~bundle ~tree_shake:(not no_tree_shake) ~linkall + else + let with_output f = + match output_file with + | None -> f stdout + | Some file -> Filename.gen_file file f + in + with_output (fun output -> + Link_js.link + ~output + ~linkall + ~mklib + ~files:js_files + ~source_map + ~resolve_sourcemap_url) let info = Info.make diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index 4689391099..c0bf60a3a8 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -32,6 +32,11 @@ type optimized_result = ; shapes : Shape.t StringMap.t } +(* Experimental ES module output. [runtime_import] is the module specifier + units use to import the runtime; [None] when the runtime is part of the + emitted program (whole-program compilation or the runtime itself). *) +type esm = { runtime_import : string option } + let should_export = function | `Iife -> false | `Named _ | `Anonymous -> true @@ -243,6 +248,7 @@ let o3 = loop 30 "round" (round Profile.O3) 1 +> print let generate ~exported_runtime + ~esm_unit ~wrap_with_fun ~warn_on_unhandled_effect { program; variable_uses; trampolined_calls; deadcode_sentinel; in_cps; shapes = _ } = @@ -251,6 +257,7 @@ let generate Generate.f program ~exported_runtime + ~esm_unit ~live_vars:variable_uses ~trampolined_calls ~in_cps @@ -346,7 +353,36 @@ let gen_missing js missing = let mark_start_of_generated_code = Debug.find ~even_if_quiet:true "mark-runtime-gen" -let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) : +(* Bind the runtime primitives a separately compiled ES module unit uses + with a named import from the runtime module. Avoid a namespace import + ([import * as runtime]): named imports keep the output statically + analyzable (tree shaking, bundlers). This runs at the end of the + pipeline, once the set of free variables is final. *) +let esm_unitize ~runtime_import js = + let free = ref StringSet.empty in + let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in + o#program js; + let provided = StringSet.union (Primitive.get_external ()) (Linker.list_all ()) in + let to_import = StringSet.inter !free provided in + if StringSet.is_empty to_import + then js + else + let open Javascript in + let named = + List.map (StringSet.elements to_import) ~f:(fun name -> + let name = Utf8_string.of_string_exn name in + name, ident name) + in + ( Import + ( { from = Utf8_string.of_string_exn runtime_import + ; kind = Named (None, named) + ; withClause = None + } + , Parse_info.zero ) + , N ) + :: js + +let link' ~esm ~export_runtime ~standalone ~link (js : Javascript.statement_list) : Linker.output = if (not export_runtime) && not standalone then { runtime_code = js; always_required_codes = [] } @@ -417,6 +453,15 @@ let link' ~export_runtime ~standalone ~link (js : Javascript.statement_list) : let open Javascript in match Linker.all linkinfos with | [] -> js + | all when Option.is_some esm -> + (* The runtime is emitted as an ES module: export the primitives + by name instead of publishing them on [globalThis.jsoo_runtime]. *) + let names = + List.map all ~f:(fun name -> + let name = Utf8_string.of_string_exn name in + ident name, name) + in + (Export (ExportNames names, Parse_info.zero), N) :: js | all -> let all = List.map all ~f:(fun name -> @@ -534,7 +579,11 @@ let output formatter ~source_map () js = if times () then Format.eprintf " write: %a@." Timer.print t; sm -let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_codes } = +let pack + ~esm + ~wrap_with_fun + ~standalone + { Linker.runtime_code = js; always_required_codes } = let module J = Javascript in let t = Timer.make () in if times () then Format.eprintf "Start Optimizing js...@."; @@ -626,8 +675,37 @@ let pack ~wrap_with_fun ~standalone { Linker.runtime_code = js; always_required_ ~f:(fun { Linker.program; filename = _; requires = _ } -> wrap_in_iife ~use_strict:false program) in - let runtime_js = wrap_in_iife ~use_strict:(Config.Flag.strictmode ()) js in - let js = always_required_js @ [ runtime_js ] in + let runtime_js = + if esm + then ( + (* ES modules provide their own (strict) top-level scope: emit the + program unwrapped so that imports/exports stay at the top level. The + program body is generated as a function body; drop the trailing + [return], which is illegal at the top level of a module. *) + let js = + match List.rev js with + | (J.Return_statement (None, _), _) :: rev -> List.rev rev + | _ -> js + in + (* The runtime uses CommonJS' [require] to load node modules; it is not + available in module scope. Shim it when needed. *) + let free = ref StringSet.empty in + let o = new Js_traverse.fast_freevar (fun s -> free := StringSet.add s !free) in + o#program js; + if StringSet.mem "require" !free + then + let lex = + Parse_js.Lexer.of_string + {| +import { createRequire } from "node:module"; +const require = createRequire(import.meta.url); +|} + in + Parse_js.parse `Module lex @ js + else js) + else [ wrap_in_iife ~use_strict:(Config.Flag.strictmode ()) js ] + in + let js = always_required_js @ runtime_js in let js = match wrap_with_fun, standalone with | `Named name, (true | false) -> @@ -648,6 +726,9 @@ if (typeof module === 'object' && module.exports) { js @ export_node | `Anonymous, _ -> js | `Iife, false -> js + | `Iife, true when esm -> + (* Modern environments only: no need for the globalThis polyfill. *) + js | `Iife, true -> let e = let s = @@ -694,16 +775,24 @@ let configure formatter = let pretty = Config.Flag.pretty () in Pretty_print.set_compact formatter (not pretty) -let link_and_pack ?(standalone = true) ?(wrap_with_fun = `Iife) ?(link = `No) p = +let link_and_pack + ?(standalone = true) + ?esm + ?(check = true) + ?(wrap_with_fun = `Iife) + ?(link = `No) + p = let export_runtime = match link with | `All | `All_from _ -> true | `Needed | `No -> false in - p - |> link' ~export_runtime ~standalone ~link - |> pack ~wrap_with_fun ~standalone - |> check_js + let p = + p + |> link' ~esm ~export_runtime ~standalone ~link + |> pack ~esm:(Option.is_some esm) ~wrap_with_fun ~standalone + in + if check then check_js p else p let optimize ~shapes ~profile ~keep_flow_data p = let deadcode_sentinel = @@ -744,13 +833,34 @@ let optimize_for_wasm ~shapes ~profile p = | Some data -> data | None -> Global_flow.f ~fast:false optimized_code.program ) -let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p = +let full ~standalone ~esm ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p = let optimized_code, _ = optimize ~shapes ~profile ~keep_flow_data:false p in - let exported_runtime = not standalone in + (* In ESM mode, separately compiled units reference runtime primitives as + plain (free) identifiers, bound by a named import from the runtime + module, instead of going through an exported runtime object. *) + let exported_runtime = (not standalone) && Option.is_none esm in + let esm_unit = + match esm with + | Some { runtime_import = Some _ } when not standalone -> true + | Some { runtime_import = _ } | None -> false + in + let esm_finalize js = + match esm with + | Some { runtime_import = Some spec } when not standalone -> + (* The primitive check runs here rather than in [link_and_pack]: + primitives are free variables until the runtime import is added. *) + check_js (esm_unitize ~runtime_import:spec js) + | Some { runtime_import = _ } | None -> js + in let emit formatter = - generate ~exported_runtime ~wrap_with_fun ~warn_on_unhandled_effect:standalone - +> link_and_pack ~standalone ~wrap_with_fun ~link + generate + ~exported_runtime + ~esm_unit + ~wrap_with_fun + ~warn_on_unhandled_effect:standalone + +> link_and_pack ~standalone ?esm ~check:(not esm_unit) ~wrap_with_fun ~link +> simplify_js + +> esm_finalize +> name_variables +> output formatter ~source_map () in @@ -765,14 +875,25 @@ let full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatte shapes_v; emit formatter optimized_code, shapes_v -let full_no_source_map ~formatter ~shapes ~standalone ~wrap_with_fun ~profile ~link p = +let full_no_source_map ~formatter ~shapes ~standalone ~esm ~wrap_with_fun ~profile ~link p + = let (_ : Source_map.info * _) = - full ~shapes ~standalone ~wrap_with_fun ~profile ~link ~source_map:false ~formatter p + full + ~shapes + ~standalone + ~esm + ~wrap_with_fun + ~profile + ~link + ~source_map:false + ~formatter + p in () let f ?(standalone = true) + ?esm ?(wrap_with_fun = `Iife) ?(profile = Profile.O1) ?(shapes = false) @@ -780,16 +901,25 @@ let f ~source_map ~formatter p = - full ~standalone ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p + full ~standalone ~esm ~wrap_with_fun ~shapes ~profile ~link ~source_map ~formatter p let f' ?(standalone = true) + ?esm ?(wrap_with_fun = `Iife) ?(profile = Profile.O1) ~link formatter p = - full_no_source_map ~formatter ~shapes:false ~standalone ~wrap_with_fun ~profile ~link p + full_no_source_map + ~formatter + ~shapes:false + ~standalone + ~esm + ~wrap_with_fun + ~profile + ~link + p let from_string ~prims ~debug s formatter = let p = Parse_bytecode.from_string ~prims ~debug s in @@ -797,6 +927,7 @@ let from_string ~prims ~debug s formatter = ~formatter ~shapes:false ~standalone:false + ~esm:None ~wrap_with_fun:`Anonymous ~profile:O1 ~link:`No diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index d4c67a5143..d6f31b83b9 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -35,8 +35,14 @@ val optimize_for_wasm : -> Code.program -> optimized_result * (Global_flow.state * Global_flow.info) +type esm = { runtime_import : string option } +(** Experimental ES module output. [runtime_import] is the module specifier + units use to import the runtime; [None] when the runtime is part of the + emitted program (whole-program compilation or the runtime itself). *) + val f : ?standalone:bool + -> ?esm:esm -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:Profile.t -> ?shapes:bool @@ -48,6 +54,7 @@ val f : val f' : ?standalone:bool + -> ?esm:esm -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:Profile.t -> link:[ `All | `All_from of string list | `Needed | `No ] @@ -64,6 +71,8 @@ val from_string : val link_and_pack : ?standalone:bool + -> ?esm:esm + -> ?check:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?link:[ `All | `All_from of string list | `Needed | `No ] -> Javascript.statement_list diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index 926f790c67..c394e73f0e 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -307,6 +307,11 @@ module Ctx = struct ; live : Deadcode.variable_uses ; share : Share.t ; exported_runtime : (Code.Var.t * bool ref) option + ; esm_unit_globals : (Code.Var.t String.Hashtbl.t * bool ref) option + (* When emitting a separately compiled unit as an ES module: + variables bound to other units by a default import (keyed by + unit name), and whether the unit's module block has been + exported. *) ; should_export : bool ; effect_warning : bool ref ; trampolined_calls : Effects.trampolined_calls @@ -320,6 +325,7 @@ module Ctx = struct let initial ~warn_on_unhandled_effect ~exported_runtime + ~esm_unit_globals ~should_export ~deadcode_sentinel ~mutated_vars @@ -334,6 +340,7 @@ module Ctx = struct ; live ; share ; exported_runtime + ; esm_unit_globals ; should_export ; effect_warning = ref (not warn_on_unhandled_effect) ; trampolined_calls @@ -1818,6 +1825,56 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t and translate_instr ctx expr_queue loc instr = let open Expr_builder in match instr with + (* When emitting a separately compiled unit as an ES module, other units + are referenced through the module system instead of the runtime's + global table: [caml_get_global] becomes a binding introduced by a + default import of the unit's module (emitted at the end of the + generation, see [f]) and [caml_register_global] becomes + [export default]. Predefined exceptions use the distinct [*_predef] + primitives and still go through the runtime. *) + | Let (x, Prim (Extern ("caml_get_global", _), [ Pc (NativeString name) ])) + when Option.is_some ctx.Ctx.esm_unit_globals -> ( + let globals, _ = + match ctx.Ctx.esm_unit_globals with + | Some g -> g + | None -> assert false + in + let name = + match name with + | Byte s | Utf (Utf8 s) -> s + in + match String.Hashtbl.find_opt globals name with + | None -> + (* [x] is bound by the import statement. Even if the value is + unused, the import is emitted: importing a unit evaluates it, + like linking it does. *) + String.Hashtbl.add globals name x; + [], expr_queue + | Some y -> + flush_queue + expr_queue + loc + (let* loc = statement_loc loc in + return [ J.variable_declaration [ J.V x, (J.EVar (J.V y), loc) ], loc ])) + | Let (x, Prim (Extern ("caml_register_global", _), [ Pv v; Pc (NativeString _) ])) + when match ctx.Ctx.esm_unit_globals with + | Some (_, { contents = false }) -> true + | Some (_, { contents = true }) | None -> false -> + let () = + match ctx.Ctx.esm_unit_globals with + | Some (_, exported) -> exported := true + | None -> assert false + in + flush_queue + expr_queue + loc + (let* cv = access ~ctx v in + let* () = info mutator_p in + let* loc = statement_loc loc in + let export = J.Export (J.ExportDefaultExpression cv, Parse_info.zero), loc in + if ctx.Ctx.live.(Var.idx x) = 0 + then return [ export ] + else return [ export; J.variable_declaration [ J.V x, (int 0, loc) ], loc ]) | Assign (x, y) -> flush_queue expr_queue @@ -2587,6 +2644,7 @@ let compile_program ctx pc = let f (p : Code.program) ~exported_runtime + ~esm_unit ~live_vars ~trampolined_calls ~in_cps @@ -2602,10 +2660,14 @@ let f let exported_runtime = if exported_runtime then Some (Code.Var.fresh_n "runtime", ref false) else None in + let esm_unit_globals = + if esm_unit then Some (String.Hashtbl.create 8, ref false) else None + in let ctx = Ctx.initial ~warn_on_unhandled_effect ~exported_runtime + ~esm_unit_globals ~should_export ~deadcode_sentinel ~mutated_vars @@ -2618,6 +2680,26 @@ let f share in let p = compile_program ctx p.start in + (* Bind the units referenced through [caml_get_global] with default + imports of their modules. *) + let p = + match esm_unit_globals with + | None -> p + | Some (globals, _) -> + let imports = + String.Hashtbl.fold (fun name v acc -> (name, v) :: acc) globals [] + |> List.sort ~cmp:(fun (a, _) (b, _) -> String.compare a b) + |> List.map ~f:(fun (name, v) -> + ( J.Import + ( { J.from = Utf8_string.of_string_exn ("./" ^ name ^ ".js") + ; kind = J.Default (J.V v) + ; withClause = None + } + , Parse_info.zero ) + , J.N )) + in + imports @ p + in if times () then Format.eprintf " code gen.: %a@." Timer.print t'; p diff --git a/compiler/lib/generate.mli b/compiler/lib/generate.mli index 33315529df..e46c5eb6a1 100644 --- a/compiler/lib/generate.mli +++ b/compiler/lib/generate.mli @@ -21,6 +21,7 @@ val f : Code.program -> exported_runtime:bool + -> esm_unit:bool -> live_vars:Deadcode.variable_uses -> trampolined_calls:Effects.trampolined_calls -> in_cps:Effects.in_cps diff --git a/compiler/lib/js_variable_coalescing.ml b/compiler/lib/js_variable_coalescing.ml index 0bf86fae61..47ea1d4415 100644 --- a/compiler/lib/js_variable_coalescing.ml +++ b/compiler/lib/js_variable_coalescing.ml @@ -149,12 +149,20 @@ let mark_captured_variables pass_stats captured_vars f = (* Collect local variables in the current function *) let collect_locals captured_vars params stmts = let locals = ref Var.Set.empty in + (* Variables exported by name are live bindings: importers observe every + later update, so their slot can never be reused. *) + let exported = ref Var.Set.empty in let add i = match i with | V v -> if not (Var.Tbl.get captured_vars v) then locals := Var.Set.add v !locals | S _ -> () in let add_list ids = List.iter ids ~f:add in + let add_exported i = + match i with + | V v -> exported := Var.Set.add v !exported + | S _ -> () + in let visitor = object inherit Js_traverse.iter as super @@ -162,6 +170,25 @@ let collect_locals captured_vars params stmts = method! fun_decl _ = () (* Do not descend into nested functions *) method! statement s = + (match s with + | Export (e, _) -> ( + match e with + | ExportNames l -> List.iter l ~f:(fun (i, _) -> add_exported i) + | ExportVar (_, decls) -> + List.iter decls ~f:(fun d -> + List.iter (bound_idents_of_variable_declaration d) ~f:add_exported) + | ExportFun (i, _) + | ExportClass (i, _) + | ExportDefaultFun (Some i, _) + | ExportDefaultClass (Some i, _) -> add_exported i + | ExportDefaultFun (None, _) + | ExportDefaultClass (None, _) + | ExportDefaultExpression _ + (* A default-exported expression is evaluated once: not a live + binding, the variables it uses stay coalescable. *) + | ExportFrom _ + | CoverExportFrom _ -> ()) + | _ -> ()); (match s with | Variable_statement (Var, decls) -> List.iter decls ~f:(fun d -> @@ -194,9 +221,10 @@ let collect_locals captured_vars params stmts = in add_list (bound_idents_of_params params); visitor#statements stmts; + let locals = Var.Set.diff !locals !exported in (* In pretty mode, only coalesce compiler-generated variables to preserve user-defined variable names for readability. *) - if Config.Flag.pretty () then Var.Set.filter Var.generated_name !locals else !locals + if Config.Flag.pretty () then Var.Set.filter Var.generated_name locals else locals (* Liveness Analysis *) @@ -531,7 +559,29 @@ let build_cfg stmts candidates param_vars = let body_entry = visit_stmt context exit body in let u, _ = expr_use_def e in add_node (Use u) [ body_entry ] - | Import (_, _) | Export (_, _) -> exit + | Import (_, _) -> + (* Import bindings are not coalescing candidates (they are constant + and not [var]-declared): nothing to record. *) + exit + | Export (e, _) -> ( + match e with + | ExportDefaultExpression e -> + let u, _ = expr_use_def e in + add_node (Use u) [ exit ] + | ExportNames l -> + (* Excluded from candidates; recorded for robustness. *) + let u = + List.fold_left l ~init:Var.Set.empty ~f:(fun acc (i, _) -> + add_var candidates i acc) + in + add_node (Use u) [ exit ] + | ExportVar _ + | ExportFun _ + | ExportClass _ + | ExportDefaultFun _ + | ExportDefaultClass _ + | ExportFrom _ + | CoverExportFrom _ -> exit) (* Visits a statement that owns its own break/continue context: iteration statements ([while]/[do-while]/[for]/[for-in]/[for-of]/[for-await-of]) and [switch]. [labels] are the labels (possibly empty) under which this