Compiler: allow to link cmo.js into a cma.js (#1428)

This is useful to achieve better incrementatlity during sepearate compilation.

Author: hhugo

CHANGES.md

@@ -1,3 +1,9 @@
+# dev
+## Features/Changes
+* Compiler: jsoo link archive with -a (#1428)
+
+## Bug fixes
+
 # 5.1.1 (2023-03-15) - Lille
 ## Bug fixes
 * Compiler: fix jsoo link in presence of --disable use-js-string (#1430)

compiler/bin-js_of_ocaml/link.ml

@@ -28,6 +28,8 @@ type t =
   ; output_file : string option
   ; resolve_sourcemap_url : bool
   ; linkall : bool
+  ; mklib : bool
+  ; toplevel : bool
   }
 
 let options =
@@ -65,6 +67,17 @@ let options =
     let doc = "Link all compilation units." in
     Arg.(value & flag & info [ "linkall" ] ~doc)
   in
+  let mklib =
+    let doc =
+      "Build a library (.cma.js file) with the js files (.cmo.js files) given on the \
+       command line. Similar to ocamlc -a."
+    in
+    Arg.(value & flag & info [ "a" ] ~doc)
+  in
+  let toplevel =
+    let doc = "Compile a toplevel." in
+    Arg.(value & flag & info [ "toplevel" ] ~doc)
+  in
   let build_t
       common
       no_sourcemap
@@ -74,7 +87,9 @@ let options =
       output_file
       resolve_sourcemap_url
       js_files
-      linkall =
+      linkall
+      mklib
+      toplevel =
     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)
@@ -97,7 +112,16 @@ let options =
             } )
       else None
     in
-    `Ok { common; output_file; js_files; source_map; resolve_sourcemap_url; linkall }
+    `Ok
+      { common
+      ; output_file
+      ; js_files
+      ; source_map
+      ; resolve_sourcemap_url
+      ; linkall
+      ; mklib
+      ; toplevel
+      }
   in
   let t =
     Term.(
@@ -110,19 +134,37 @@ let options =
       $ output_file
       $ resolve_sourcemap_url
       $ js_files
-      $ linkall)
+      $ linkall
+      $ mklib
+      $ toplevel)
   in
   Term.ret t
 
-let f { common; output_file; source_map; resolve_sourcemap_url; js_files; linkall } =
+let f
+    { common
+    ; output_file
+    ; source_map
+    ; resolve_sourcemap_url
+    ; js_files
+    ; linkall
+    ; mklib
+    ; toplevel
+    } =
   Jsoo_cmdline.Arg.eval common;
   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 ~files:js_files ~source_map ~resolve_sourcemap_url)
+      Link_js.link
+        ~output
+        ~linkall
+        ~mklib
+        ~toplevel
+        ~files:js_files
+        ~source_map
+        ~resolve_sourcemap_url)
 
 let info =
   Info.make

compiler/lib/build_info.ml

@@ -61,6 +61,8 @@ let create kind =
   ]
   |> List.fold_left ~init:StringMap.empty ~f:(fun acc (k, v) -> StringMap.add k v acc)
 
+let with_kind t kind = StringMap.add "kind" (string_of_kind kind) t
+
 let prefix = "//# buildInfo:"
 
 let to_string info =

compiler/lib/build_info.mli

@@ -34,6 +34,8 @@ val to_string : t -> string
 
 val parse : string -> t option
 
+val with_kind : t -> kind -> t
+
 exception
   Incompatible_build_info of
     { key : string

compiler/lib/link_js.ml

@@ -101,6 +101,8 @@ module Line_writer : sig
 
   val write : ?source:Line_reader.t -> t -> string -> unit
 
+  val write_lines : ?source:Line_reader.t -> t -> string -> unit
+
   val lnum : t -> int
 end = struct
   type t =
@@ -134,6 +136,16 @@ end = struct
     t.source <- source;
     t.lnum <- t.lnum + lnum_off
 
+  let write_lines ?source t lines =
+    let l = String.split_on_char ~sep:'\n' lines in
+    let rec w = function
+      | [ "" ] | [] -> ()
+      | s :: xs ->
+          write ?source t s;
+          w xs
+    in
+    w l
+
   let lnum t = t.lnum
 end
 
@@ -231,7 +243,10 @@ end = struct
     build_info, units
 end
 
-let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
+let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source_map =
+  (* we currently don't do anything with [toplevel]. It could be used
+     to conditionally include link_info ?*)
+  ignore (toplevel : bool);
   let t = Timer.make () in
   let oc = Line_writer.of_channel output in
   let warn_effects = ref false in
@@ -255,6 +270,7 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
           ~f:(fun (info : Unit_info.t) (requires, to_link, all) ->
             let all = StringSet.union all info.provides in
             if (not (Config.Flag.auto_link ()))
+               || mklib
                || cmo_file
                || linkall
                || info.force_link
@@ -266,7 +282,7 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
             else requires, to_link, all))
   in
   let skip = StringSet.diff all to_link in
-  if not (StringSet.is_empty missing)
+  if (not (StringSet.is_empty missing)) && not mklib
   then
     failwith
       (Printf.sprintf
@@ -290,6 +306,8 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
                   : int);
               sym_js := s :: !sym_js)
             u.Unit_info.provides));
+
+  let build_info_emitted = ref false in
   List.iter files ~f:(fun (file, (build_info_for_file, units)) ->
       let sm_for_file = ref None in
       let ic = Line_reader.open_ file in
@@ -311,7 +329,14 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
                  file
                  line
              with
-            | Keep | Build_info _ -> copy ic oc
+            | Keep -> copy ic oc
+            | Build_info bi ->
+                skip ic;
+                if not !build_info_emitted
+                then (
+                  let bi = if mklib then Build_info.with_kind bi `Cma else bi in
+                  Line_writer.write_lines oc (Build_info.to_string bi);
+                  build_info_emitted := true)
             | Drop -> skip ic
             | Unit ->
                 let u = Units.read ic Unit_info.empty in
@@ -327,7 +352,11 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
                   then
                     Format.eprintf
                       "Copy %s@."
-                      (String.concat ~sep:"," (StringSet.elements u.provides)))
+                      (String.concat ~sep:"," (StringSet.elements u.provides));
+                  if mklib
+                  then
+                    let u = if linkall then { u with force_link = true } else u in
+                    Line_writer.write_lines oc (Unit_info.to_string u))
                 else (
                   if debug ()
                   then
@@ -345,7 +374,7 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
                     skip ic
                   done)
             | Source_map x ->
-                Line_reader.drop ic;
+                skip ic;
                 sm_for_file := Some x);
             read ()
       in
@@ -380,7 +409,7 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
             (Parse_bytecode.Debug.create ~include_cmis:false false)
             code;
           let content = Buffer.contents b in
-          String.split_on_char ~sep:'\n' content |> List.iter ~f:(Line_writer.write oc));
+          Line_writer.write_lines oc content);
       (match !sm_for_file with
       | None -> ()
       | Some x -> sm := (x, !reloc) :: !sm);
@@ -424,8 +453,8 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
               Line_writer.write oc s));
       if times () then Format.eprintf "  sourcemap: %a@." Timer.print t
 
-let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
-  try link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map
+let link ~output ~linkall ~mklib ~toplevel ~files ~resolve_sourcemap_url ~source_map =
+  try link ~output ~linkall ~toplevel ~mklib ~files ~resolve_sourcemap_url ~source_map
   with Build_info.Incompatible_build_info { key; first = f1, v1; second = f2, v2 } ->
     let string_of_v = function
       | None -> "<empty>"

compiler/lib/link_js.mli

@@ -20,6 +20,8 @@
 val link :
      output:out_channel
   -> linkall:bool
+  -> mklib:bool
+  -> toplevel:bool
   -> files:string list
   -> resolve_sourcemap_url:bool
   -> source_map:(string option * Source_map.t) option