Compiler: new include-partial-runtime flag

Author: hhugo

CHANGES.md

@@ -1,9 +1,13 @@
-# dev
+# 5.8.1 (2024-05-??) - ?
 
 ## Features/Changes
 
 * Library: new Typed_array.Bytes module.
 
+## Bug fixes
+
+* Compiler: fix #1509
+
 # 5.8.0 (2024-04-20) - Lille
 
 ## Features/Changes

compiler/bin-js_of_ocaml/build_fs.ml

@@ -77,6 +77,7 @@ function jsoo_create_file_extern(name,content){
         Driver.f
           ~standalone:true
           ~wrap_with_fun:`Iife
+          ~link:`Needed
           pfs_fmt
           (Parse_bytecode.Debug.create ~include_cmis:false false)
           code

compiler/bin-js_of_ocaml/cmd_arg.ml

@@ -46,6 +46,7 @@ type t =
   ; source_map : (string option * Source_map.t) option
   ; runtime_files : string list
   ; no_runtime : bool
+  ; include_partial_runtime : bool
   ; runtime_only : bool
   ; output_file : [ `Name of string | `Stdout ] * bool
   ; input_file : string option
@@ -122,6 +123,12 @@ let options =
     let doc = "Do not include the standard runtime." in
     Arg.(value & flag & info [ "noruntime"; "no-runtime" ] ~doc)
   in
+  let include_partial_runtime =
+    let doc =
+      "Include (partial) runtime when compiling cmo and cma files to JavaScript."
+    in
+    Arg.(value & flag & info [ "include-partial-runtime" ] ~doc)
+  in
   let no_sourcemap =
     let doc =
       "Don't generate source map. All other source map related flags will be be ignored."
@@ -263,6 +270,7 @@ let options =
       no_cmis
       profile
       no_runtime
+      include_partial_runtime
       no_sourcemap
       sourcemap
       sourcemap_inline_in_js
@@ -338,6 +346,7 @@ let options =
       ; include_dirs
       ; runtime_files
       ; no_runtime
+      ; include_partial_runtime
       ; runtime_only = false
       ; fs_files
       ; fs_output
@@ -367,6 +376,7 @@ let options =
       $ no_cmis
       $ profile
       $ noruntime
+      $ include_partial_runtime
       $ no_sourcemap
       $ sourcemap
       $ sourcemap_inline_in_js
@@ -576,6 +586,7 @@ let options_runtime_only =
       ; include_dirs
       ; runtime_files
       ; no_runtime
+      ; include_partial_runtime = false
       ; runtime_only = true
       ; fs_files
       ; fs_output

compiler/bin-js_of_ocaml/cmd_arg.mli

@@ -26,6 +26,7 @@ type t =
   ; source_map : (string option * Source_map.t) option
   ; runtime_files : string list
   ; no_runtime : bool
+  ; include_partial_runtime : bool
   ; runtime_only : bool
   ; output_file : [ `Name of string | `Stdout ] * bool
   ; input_file : string option

compiler/bin-js_of_ocaml/compile.ml

@@ -68,7 +68,7 @@ let run
     { Cmd_arg.common
     ; profile
     ; source_map
-    ; runtime_files
+    ; runtime_files = runtime_files_from_cmdline
     ; no_runtime
     ; input_file
     ; output_file
@@ -87,6 +87,7 @@ let run
     ; fs_external
     ; export_file
     ; keep_unit_names
+    ; include_partial_runtime
     } =
   let include_cmis = toplevel && not no_cmis in
   let custom_header = common.Jsoo_cmdline.Arg.custom_header in
@@ -122,8 +123,10 @@ let run
     if (not no_runtime) && (toplevel || dynlink)
     then
       let add_if_absent x l = if List.mem x ~set:l then l else x :: l in
-      runtime_files |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js"
-    else runtime_files
+      runtime_files_from_cmdline
+      |> add_if_absent "+toplevel.js"
+      |> add_if_absent "+dynlink.js"
+    else runtime_files_from_cmdline
   in
   let runtime_files, builtin =
     List.partition_map runtime_files ~f:(fun name ->
@@ -175,7 +178,7 @@ let run
             , noloc )
           ])
   in
-  let output (one : Parse_bytecode.one) ~standalone ~source_map ~linkall output_file =
+  let output (one : Parse_bytecode.one) ~standalone ~source_map ~link output_file =
     check_debug one;
     let init_pseudo_fs = fs_external && standalone in
     let sm =
@@ -192,7 +195,7 @@ let run
           Driver.f
             ~standalone
             ?profile
-            ~linkall
+            ~link
             ~wrap_with_fun
             ?source_map
             fmt
@@ -216,7 +219,7 @@ let run
             Driver.f
               ~standalone
               ?profile
-              ~linkall
+              ~link
               ~wrap_with_fun
               ?source_map
               fmt
@@ -228,7 +231,14 @@ let run
                   let instr = fs_instr2 in
                   let code = Code.prepend Code.empty instr in
                   let pfs_fmt = Pretty_print.to_out_channel chan in
-                  Driver.f' ~standalone ?profile ~wrap_with_fun pfs_fmt one.debug code));
+                  Driver.f'
+                    ~standalone
+                    ~link:`Needed
+                    ?profile
+                    ~wrap_with_fun
+                    pfs_fmt
+                    one.debug
+                    code));
           res
     in
     if times () then Format.eprintf "compilation: %a@." Timer.print t;
@@ -244,11 +254,14 @@ let run
     let uinfo = Unit_info.of_cmo cmo in
     Pretty_print.string fmt "\n";
     Pretty_print.string fmt (Unit_info.to_string uinfo);
-    output code ~source_map ~standalone ~linkall:false output_file
+    output code ~source_map ~standalone ~link:`No output_file
   in
-  let output_runtime ~standalone ~source_map ((_, fmt) as output_file) =
+  let output_partial_runtime ~standalone ~source_map ((_, fmt) as output_file) =
     assert (not standalone);
-    let uinfo = Unit_info.of_primitives (Linker.list_all () |> StringSet.elements) in
+    let uinfo =
+      Unit_info.of_primitives
+        (Linker.list_all ~from:runtime_files_from_cmdline () |> StringSet.elements)
+    in
     Pretty_print.string fmt "\n";
     Pretty_print.string fmt (Unit_info.to_string uinfo);
     let code =
@@ -257,7 +270,12 @@ let run
       ; debug = Parse_bytecode.Debug.create ~include_cmis:false false
       }
     in
-    output code ~source_map ~standalone ~linkall:true output_file
+    output
+      code
+      ~source_map
+      ~standalone
+      ~link:(`All_from runtime_files_from_cmdline)
+      output_file
   in
   (if runtime_only
    then (
@@ -280,7 +298,7 @@ let run
        (fun ~standalone ~source_map ((_, fmt) as output_file) ->
          Pretty_print.string fmt "\n";
          Pretty_print.string fmt (Unit_info.to_string uinfo);
-         output code ~source_map ~standalone ~linkall:true output_file))
+         output code ~source_map ~standalone ~link:`All output_file))
    else
      let kind, ic, close_ic, include_dirs =
        match input_file with
@@ -318,7 +336,7 @@ let run
            ~build_info:(Build_info.create `Exe)
            ~source_map
            (fst output_file)
-           (output code ~linkall)
+           (output code ~link:(if linkall then `All else `Needed))
      | `Cmo cmo ->
          let output_file =
            match output_file, keep_unit_names with
@@ -341,7 +359,6 @@ let run
              cmo
              ic
          in
-         let linkall = linkall || toplevel || dynlink in
          if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
          output_gen
            ~standalone:false
@@ -351,12 +368,33 @@ let run
            output_file
            (fun ~standalone ~source_map output ->
              let source_map =
-               if linkall
-               then output_runtime ~standalone ~source_map output
-               else source_map
+               if not include_partial_runtime
+               then source_map
+               else output_partial_runtime ~standalone ~source_map output
              in
              output_partial cmo code ~standalone ~source_map output)
      | `Cma cma when keep_unit_names ->
+         (if include_partial_runtime
+          then
+            let output_file =
+              let gen dir = Filename.concat dir "runtime.js" in
+              match output_file with
+              | `Stdout, false -> gen "./"
+              | `Name x, false -> gen (Filename.dirname x)
+              | `Name x, true
+                when String.length x > 0 && Char.equal x.[String.length x - 1] '/' ->
+                  gen x
+              | `Stdout, true | `Name _, true ->
+                  failwith "use [-o dirname/] or remove [--keep-unit-names]"
+            in
+            output_gen
+              ~standalone:false
+              ~custom_header
+              ~build_info:(Build_info.create `Runtime)
+              ~source_map
+              (`Name output_file)
+              (fun ~standalone ~source_map output ->
+                output_partial_runtime ~standalone ~source_map output));
          List.iter cma.lib_units ~f:(fun cmo ->
              let output_file =
                match output_file with
@@ -392,10 +430,11 @@ let run
                (`Name output_file)
                (output_partial cmo code))
      | `Cma cma ->
-         let linkall = linkall || toplevel || dynlink in
          let f ~standalone ~source_map output =
            let source_map =
-             if linkall then output_runtime ~standalone ~source_map output else source_map
+             if not include_partial_runtime
+             then source_map
+             else output_partial_runtime ~standalone ~source_map output
            in
            List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo ->
                let t1 = Timer.make () in