Compiler: allow to link cmo.js into a cma.js

This is useful to achieve better incrementatlity during sepearate compilation.

Author: hhugo

compiler/bin-js_of_ocaml/link.ml

@@ -28,6 +28,7 @@ type t =
   ; output_file : string option
   ; resolve_sourcemap_url : bool
   ; linkall : bool
+  ; mklib : bool
   }
 
 let options =
@@ -65,6 +66,14 @@ let options =
     let doc = "Link all compilation units." in
     Arg.(value & flag & info [ "linkall" ] ~doc)
   in
+  let mklib =
+    let doc = "similar to -a" in
+    Arg.(value & flag & info [ "a" ] ~doc)
+  in
+  let toplevel =
+    let doc = "toplevel" in
+    Arg.(value & flag & info [ "toplevel" ] ~doc)
+  in
   let build_t
       common
       no_sourcemap
@@ -74,7 +83,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 +108,8 @@ 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 }
   in
   let t =
     Term.(
@@ -110,19 +122,28 @@ 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 }
+    =
   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
+        ~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,7 @@ end = struct
     build_info, units
 end
 
-let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
+let link ~output ~linkall ~mklib ~files ~resolve_sourcemap_url ~source_map =
   let t = Timer.make () in
   let oc = Line_writer.of_channel output in
   let warn_effects = ref false in
@@ -255,6 +267,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 +279,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 +303,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 +326,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 +349,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 +371,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
@@ -378,7 +404,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);
@@ -422,8 +448,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 ~files ~resolve_sourcemap_url ~source_map =
+  try link ~output ~linkall ~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,7 @@
 val link :
      output:out_channel
   -> linkall:bool
+  -> mklib:bool
   -> files:string list
   -> resolve_sourcemap_url:bool
   -> source_map:(string option * Source_map.t) option

compiler/tests-sourcemap/dump.reference

@@ -5,5 +5,6 @@ b.ml:1:10 -> 17:   function f(x){<>return x - 1 | 0;}
 b.ml:1:6 -> 24:   function f(x){return <>x - 1 | 0;}
 b.ml:1:15 -> 34:   function f(x){return x - 1 | 0;<>}
 b.ml:1:4 -> 23:   var Testlib_B = [0, <>f];
+d.ml:-1:-1 -> 2:  <>}
 a.ml:-1:-1 -> 3:   <>function caml_call1(f, a0){
 a.ml:-1:-1 -> 2:  <>}