Compile: do not rely on file extension for jsoo link

compiler/bin-js_of_ocaml/compile.ml

@@ -32,8 +32,7 @@ let jsoo_header formatter build_info =
   Pretty_print.string formatter "// Generated by js_of_ocaml\n";
   Pretty_print.string formatter (Build_info.to_string build_info)
 
-let output_gen ~source_map output_file f =
-  let build_info = Build_info.create () in
+let output_gen ~build_info ~source_map output_file f =
   let f chan k =
     let fmt = Pretty_print.to_out_channel chan in
     Driver.configure fmt;
@@ -255,7 +254,11 @@ let run
       ; debug = Parse_bytecode.Debug.create ~include_cmis:false false
       }
     in
-    output_gen ~source_map (fst output_file) (fun ~source_map ((_, fmt) as output_file) ->
+    output_gen
+      ~build_info:(Build_info.create `Runtime)
+      ~source_map
+      (fst output_file)
+      (fun ~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:true ~linkall:true output_file)
@@ -290,7 +293,11 @@ let run
             ic
         in
         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-        output_gen ~source_map (fst output_file) (output code ~standalone:true ~linkall)
+        output_gen
+          ~build_info:(Build_info.create `Exe)
+          ~source_map
+          (fst output_file)
+          (output code ~standalone:true ~linkall)
     | `Cmo cmo ->
         let output_file =
           match output_file, keep_unit_names with
@@ -314,7 +321,11 @@ let run
             ic
         in
         if times () then Format.eprintf "  parsing: %a@." Timer.print t1;
-        output_gen ~source_map output_file (output_partial cmo code)
+        output_gen
+          ~build_info:(Build_info.create `Cmo)
+          ~source_map
+          output_file
+          (output_partial cmo code)
     | `Cma cma when keep_unit_names ->
         List.iter cma.lib_units ~f:(fun cmo ->
             let output_file =
@@ -338,7 +349,11 @@ let run
             in
             if times ()
             then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 cmo.cu_name;
-            output_gen ~source_map (`Name output_file) (output_partial cmo code))
+            output_gen
+              ~build_info:(Build_info.create `Cma)
+              ~source_map
+              (`Name output_file)
+              (output_partial cmo code))
     | `Cma cma ->
         let f ~source_map output =
           List.fold_left cma.lib_units ~init:source_map ~f:(fun source_map cmo ->
@@ -355,7 +370,7 @@ let run
               then Format.eprintf "  parsing: %a (%s)@." Timer.print t1 cmo.cu_name;
               output_partial cmo ~source_map code output)
         in
-        output_gen ~source_map (fst output_file) f);
+        output_gen ~build_info:(Build_info.create `Cma) ~source_map (fst output_file) f);
     close_ic ());
   Debug.stop_profiling ()
 

compiler/lib/build_info.ml

@@ -19,18 +19,45 @@
 
 open! Stdlib
 
+type kind =
+  [ `Runtime
+  | `Exe
+  | `Cmo
+  | `Cma
+  | `Unknown
+  ]
+
+let all = [ `Runtime; `Exe; `Cmo; `Cma; `Unknown ]
+
+let string_of_kind = function
+  | `Runtime -> "runtime"
+  | `Exe -> "exe"
+  | `Cmo -> "cmo"
+  | `Cma -> "cma"
+  | `Unknown -> "unknown"
+
+let kind_of_string s =
+  match List.find_opt all ~f:(fun k -> String.equal s (string_of_kind k)) with
+  | None -> `Unknown
+  | Some k -> k
+
 type t = string StringMap.t
 
-let create () =
+let kind t =
+  match StringMap.find "kind" t with
+  | exception Not_found -> `Unknown
+  | s -> kind_of_string s
+
+let create kind =
   let version =
     match Compiler_version.git_version with
     | "" -> Compiler_version.s
     | v -> Printf.sprintf "%s+git-%s" Compiler_version.s v
   in
-
   [ "use-js-string", string_of_bool (Config.Flag.use_js_string ())
   ; "effects", string_of_bool (Config.Flag.effects ())
   ; "version", version
+  ; "kind", string_of_kind kind
   ]
   |> List.fold_left ~init:StringMap.empty ~f:(fun acc (k, v) -> StringMap.add k v acc)
 
@@ -91,6 +118,8 @@ let merge fname1 info1 fname2 info2 =
     StringMap.merge
       (fun k v1 v2 ->
         match k, v1, v2 with
+        | "kind", v1, v2 ->
+            if Option.equal String.equal v1 v2 then v1 else Some (string_of_kind `Unknown)
         | ("effects" | "use-js-string" | "version"), Some v1, Some v2
           when String.equal v1 v2 -> Some v1
         | (("effects" | "use-js-string" | "version") as key), v1, v2 ->

compiler/lib/build_info.mli

@@ -20,7 +20,15 @@ open! Stdlib
 
 type t
 
-val create : unit -> t
+type kind =
+  [ `Runtime
+  | `Exe
+  | `Cmo
+  | `Cma
+  | `Unknown
+  ]
+
+val create : kind -> t
 
 val to_string : t -> string
 
@@ -34,3 +42,5 @@ exception
     }
 
 val merge : string -> t -> string -> t -> t
+
+val kind : t -> kind

compiler/lib/link_js.ml

@@ -167,7 +167,7 @@ let action ~resolve_sourcemap_url ~drop_source_map file line =
 module Units : sig
   val read : Line_reader.t -> Unit_info.t -> Unit_info.t
 
-  val scan_file : string -> Unit_info.t list
+  val scan_file : string -> Build_info.t option * Unit_info.t list
 end = struct
   let rec read ic uinfo =
     match Line_reader.peek ic with
@@ -192,16 +192,31 @@ end = struct
     in
     find_next ic
 
+  let find_build_info ic =
+    let rec find_next ic =
+      match Line_reader.peek ic with
+      | None -> None
+      | Some line -> (
+          match prefix_kind line with
+          | `Json_base64 _ | `Url _ | `Other ->
+              Line_reader.drop ic;
+              find_next ic
+          | `Build_info bi -> Some bi
+          | `Unit -> None)
+    in
+    find_next ic
+
   let scan_file file =
     let ic = Line_reader.open_ file in
-    let rec scan_all acc =
+    let rec scan_all ic acc =
       match find_unit_info ic with
       | None -> List.rev acc
-      | Some x -> scan_all (x :: acc)
+      | Some x -> scan_all ic (x :: acc)
     in
-    let units = scan_all [] in
+    let build_info = find_build_info ic in
+    let units = scan_all ic [] in
     Line_reader.close ic;
-    units
+    build_info, units
 end
 
 let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
@@ -213,14 +228,21 @@ let link ~output ~linkall ~files ~resolve_sourcemap_url ~source_map =
       files
       ~init:(StringSet.empty, StringSet.empty, StringSet.empty)
       ~f:(fun file acc ->
-        let units = Units.scan_file file in
-        let cma_file = String.is_suffix file ~suffix:".cma.js" in
+        let build_info, units = Units.scan_file file in
+        let cmo_file =
+          match build_info with
+          | Some bi -> (
+              match Build_info.kind bi with
+              | `Cmo -> true
+              | `Cma | `Exe | `Runtime | `Unknown -> false)
+          | None -> false
+        in
         List.fold_right
           units
           ~init:acc
           ~f:(fun (info : Unit_info.t) (requires, to_link, all) ->
             let all = StringSet.union all info.provides in
-            if (not cma_file)
+            if cmo_file
                || linkall
                || info.force_link
                || not (StringSet.is_empty (StringSet.inter requires info.provides))