Js_of_ocaml: better incrementality when compiling libraries

Signed-off-by: Hugo Heuzard <hugo.heuzard@gmail.com>

src/dune_rules/cm_files.ml

@@ -40,6 +40,11 @@ let top_sorted_cms t ~mode =
     Obj_dir.Module.L.cm_files t.obj_dir ~kind:(Ocaml kind) modules)
 ;;
 
+let top_sorted_modules t =
+  Action_builder.map t.top_sorted_modules ~f:(fun modules ->
+    filter_excluded_modules t modules)
+;;
+
 let top_sorted_objects_and_cms t ~mode =
   Action_builder.map t.top_sorted_modules ~f:(fun modules ->
     let modules = filter_excluded_modules t modules in

src/dune_rules/cm_files.mli

@@ -17,4 +17,5 @@ val make
 
 val unsorted_objects_and_cms : t -> mode:Mode.t -> Path.t list
 val top_sorted_cms : t -> mode:Mode.t -> Path.t list Action_builder.t
+val top_sorted_modules : t -> Module.t list Action_builder.t
 val top_sorted_objects_and_cms : t -> mode:Mode.t -> Path.t list Action_builder.t

src/dune_rules/jsoo/jsoo_rules.ml

@@ -48,7 +48,7 @@ module Config : sig
   val path : t -> string
   val of_string : string -> t
   val of_flags : string list -> t
-  val to_flags : t -> string list
+  val to_flags : current:string list -> t -> string list
 end = struct
   type t =
     { js_string : bool option
@@ -121,12 +121,15 @@ end = struct
     loop default l
   ;;
 
-  let to_flags t =
-    List.concat_map (get t) ~f:(function
-      | "toplevel", true -> [ "--toplevel" ]
+  let to_flags ~current t =
+    current
+    :: List.map (get t) ~f:(function
+      | "toplevel", true ->
+        if List.mem current "--toplevel" ~equal:String.equal then [] else [ "--toplevel" ]
       | "toplevel", false -> []
       | name, true -> [ "--enable"; name ]
       | name, false -> [ "--disable"; name ])
+    |> List.concat
   ;;
 end
 
@@ -239,7 +242,6 @@ let js_of_ocaml_rule
   ~spec
   ~target
   ~sourcemap
-  ~directory_targets
   =
   let open Action_builder.O in
   let jsoo =
@@ -270,19 +272,21 @@ let js_of_ocaml_rule
            [ A "--source-map"
            ; Hidden_targets [ Path.Build.set_extension target ~ext:".map" ]
            ])
-    ; Command.Args.dyn flags
     ; (match config with
-       | None -> S []
+       | None ->
+         Dyn
+           (Action_builder.map flags ~f:(fun flags ->
+              Command.Args.S (List.map flags ~f:(fun x -> Command.Args.A x))))
        | Some config ->
          Dyn
-           (Action_builder.map config ~f:(fun config ->
+           (Action_builder.map2 flags config ~f:(fun flags config ->
               Command.Args.S
-                (List.map (Config.to_flags config) ~f:(fun x -> Command.Args.A x)))))
+                (List.map (Config.to_flags ~current:flags config) ~f:(fun x ->
+                   Command.Args.A x)))))
     ; A "-o"
     ; Target target
     ; spec
     ]
-  |> Action_builder.With_targets.add_directories ~directory_targets
 ;;
 
 let jsoo_runtime_files ~(mode : Js_of_ocaml.Mode.t) libs =
@@ -319,12 +323,21 @@ let standalone_runtime_rule ~mode cc ~runtime_files ~target ~flags =
     ~dir
     ~flags
     ~target
-    ~directory_targets:[]
     ~spec
     ~config:(Some config)
 ;;
 
-let exe_rule ~mode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~flags =
+let exe_rule
+  ~mode
+  cc
+  ~linkall
+  ~runtime_files
+  ~src
+  ~target
+  ~directory_targets
+  ~flags
+  ~sourcemap
+  =
   let dir = Compilation_context.dir cc in
   let sctx = Compilation_context.super_context cc in
   let libs = Compilation_context.requires_link cc in
@@ -361,9 +374,10 @@ let exe_rule ~mode cc ~linkall ~runtime_files ~src ~target ~directory_targets ~f
     ~dir
     ~spec
     ~target
-    ~directory_targets
     ~flags
     ~config:None
+    ~sourcemap
+  |> Action_builder.With_targets.add_directories ~directory_targets
 ;;
 
 let with_js_ext ~mode s =
@@ -406,6 +420,7 @@ let link_rule
   ~flags
   ~linkall
   ~link_time_code_gen
+  ~sourcemap
   =
   let sctx = Compilation_context.super_context cc in
   let dir = Compilation_context.dir cc in
@@ -439,12 +454,13 @@ let link_rule
     let special_units =
       List.concat_map to_link ~f:(function
         | Lib_flags.Lib_and_module.Lib _lib -> []
-        | Module (obj_dir, m) -> [ in_obj_dir' ~obj_dir ~config:None [ mod_name m ] ])
+        | Module (obj_dir, m) ->
+          [ in_obj_dir' ~obj_dir ~config:(Some config) [ mod_name m ] ])
     in
     let all_libs = List.concat_map libs ~f:(jsoo_archives ~mode ctx config) in
     let all_other_modules =
       List.map cm ~f:(fun m ->
-        Path.build (in_obj_dir ~obj_dir ~config:None [ mod_name m ]))
+        Path.build (in_obj_dir ~obj_dir ~config:(Some config) [ mod_name m ]))
     in
     let std_exit =
       Path.build
@@ -472,9 +488,10 @@ let link_rule
     ~dir
     ~spec
     ~target
-    ~directory_targets
     ~flags
     ~config:None
+    ~sourcemap
+  |> Action_builder.With_targets.add_directories ~directory_targets
 ;;
 
 let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap =
@@ -488,7 +505,6 @@ let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap =
     ~flags
     ~spec
     ~target
-    ~directory_targets:[]
     ~config
     ~sourcemap
 ;;
@@ -507,6 +523,37 @@ let build_cm sctx ~dir ~in_context ~mode ~src ~obj_dir ~config =
     ~sourcemap:Js_of_ocaml.Sourcemap.Inline
 ;;
 
+let build_cma_js sctx ~dir ~in_context ~obj_dir ~config ~linkall:_ ~mode cm_files basename
+  =
+  let name = with_js_ext ~mode basename in
+  let target = in_obj_dir ~obj_dir ~config [ name ] in
+  let flags = in_context.Js_of_ocaml.In_context.flags in
+  let modules =
+    let open Action_builder.O in
+    let+ l = Cm_files.top_sorted_modules cm_files in
+    let l =
+      List.map l ~f:(fun m ->
+        in_obj_dir
+          ~obj_dir
+          ~config
+          [ Module_name.Unique.to_string (Module.obj_name m) ^ Js_of_ocaml.Ext.cmo ~mode ]
+        |> Path.build)
+    in
+    l
+  in
+  js_of_ocaml_rule
+    sctx
+    ~dir
+    ~sub_command:Link
+    ~config:(Option.map config ~f:Action_builder.return)
+    ~flags
+    ~mode
+    ~spec:
+      (S [ A "-a"; Dyn (Action_builder.map modules ~f:(fun x -> Command.Args.Deps x)) ])
+    ~target
+    ~sourcemap:Js_of_ocaml.Sourcemap.Inline
+;;
+
 let setup_separate_compilation_rules sctx components =
   match components with
   | _ :: _ :: _ :: _ | [] | [ _ ] -> Memo.return ()

src/dune_rules/jsoo/jsoo_rules.mli

@@ -38,6 +38,18 @@ val build_exe
   -> jsoo_mode:Js_of_ocaml.Mode.t
   -> unit Memo.t
 
+val build_cma_js
+  :  Super_context.t
+  -> dir:Path.Build.t
+  -> in_context:Js_of_ocaml.In_context.t
+  -> obj_dir:Path.Build.t Obj_dir.t
+  -> config:Config.t option
+  -> linkall:bool Action_builder.t
+  -> mode:Js_of_ocaml.Mode.t
+  -> Cm_files.t
+  -> string
+  -> Action.Full.t Action_builder.With_targets.t
+
 val setup_separate_compilation_rules : Super_context.t -> string list -> unit Memo.t
 val runner : string
 

src/dune_rules/lib_rules.ml

@@ -118,6 +118,43 @@ let build_lib
              ]))
 ;;
 
+(* Build an OCaml library. *)
+let build_js_lib
+  (lib : Library.t)
+  ~sctx
+  ~expander
+  ~flags
+  ~dir
+  ~cm_files
+  ~in_context
+  ~obj_dir
+  ~mode
+  config
+  =
+  let linkall =
+    match lib.kind with
+    | Ppx_deriver _ | Ppx_rewriter _ -> Action_builder.return true
+    | Normal ->
+      let standard = Action_builder.return [] in
+      let open Action_builder.O in
+      let+ library_flags =
+        Expander.expand_and_eval_set expander lib.library_flags ~standard
+      and+ ocaml_flags = Ocaml_flags.get flags (Ocaml Byte) in
+      List.exists library_flags ~f:(String.equal "-linkall")
+      || List.exists ocaml_flags ~f:(String.equal "-linkall")
+  in
+  Jsoo_rules.build_cma_js
+    sctx
+    ~dir
+    ~config
+    ~in_context
+    ~obj_dir
+    ~linkall
+    ~mode
+    cm_files
+    (Library.archive_basename lib ~ext:(Mode.compiled_lib_ext Mode.Byte))
+;;
+
 let gen_wrapped_compat_modules (lib : Library.t) cctx =
   let modules = Compilation_context.modules cctx in
   let wrapped_compat = Modules.With_vlib.wrapped_compat modules in
@@ -472,22 +509,43 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~
       build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~cm_files)
   and* () =
     (* Build *.cma.js / *.wasma *)
-    Memo.when_ modes.ocaml.byte (fun () ->
-      let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
-      Memo.parallel_iter Js_of_ocaml.Mode.all ~f:(fun mode ->
-        let action_with_targets =
-          List.map Jsoo_rules.Config.all ~f:(fun config ->
-            Jsoo_rules.build_cm
-              sctx
-              ~dir
-              ~in_context:(Js_of_ocaml.Mode.Pair.select ~mode js_of_ocaml)
-              ~mode
-              ~config:(Some config)
-              ~src:(Path.build src)
-              ~obj_dir)
-        in
-        Memo.parallel_iter action_with_targets ~f:(fun rule ->
-          Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule)))
+    match `From_cmos with
+    | `From_cma ->
+      Memo.when_ modes.ocaml.byte (fun () ->
+        let src = Library.archive lib ~dir ~ext:(Mode.compiled_lib_ext Mode.Byte) in
+        Memo.parallel_iter Js_of_ocaml.Mode.all ~f:(fun mode ->
+          let action_with_targets =
+            List.map Jsoo_rules.Config.all ~f:(fun config ->
+              Jsoo_rules.build_cm
+                sctx
+                ~dir
+                ~in_context:(Js_of_ocaml.Mode.Pair.select ~mode js_of_ocaml)
+                ~mode
+                ~config:(Some config)
+                ~src:(Path.build src)
+                ~obj_dir)
+          in
+          Memo.parallel_iter action_with_targets ~f:(fun rule ->
+            Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule)))
+    | `From_cmos ->
+      Memo.when_ modes.ocaml.byte (fun () ->
+        Memo.parallel_iter Js_of_ocaml.Mode.all ~f:(fun mode ->
+          let action_with_targets =
+            List.map Jsoo_rules.Config.all ~f:(fun config ->
+              build_js_lib
+                (lib : Library.t)
+                ~sctx
+                ~expander
+                ~flags
+                ~dir
+                ~cm_files
+                ~in_context:(Js_of_ocaml.Mode.Pair.select ~mode js_of_ocaml)
+                ~obj_dir
+                ~mode
+                (Some config))
+          in
+          Memo.parallel_iter action_with_targets ~f:(fun rule ->
+            Super_context.add_rule sctx ~dir ~loc:lib.buildable.loc rule)))
   in
   Memo.when_
     (Dynlink_supported.By_the_os.get natdynlink_supported && modes.ocaml.native)

src/dune_rules/module_compilation.ml

@@ -315,20 +315,22 @@ let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m =
           Compilation_context.js_of_ocaml cctx
           |> Js_of_ocaml.Mode.Pair.select ~mode
           |> Memo.Option.iter ~f:(fun in_context ->
-            (* Build *.cmo.js / *.wasmo *)
+            (* Build *.cmo.js *)
             let sctx = Compilation_context.super_context cctx in
             let dir = Compilation_context.dir cctx in
             let action_with_targets =
-              Jsoo_rules.build_cm
-                sctx
-                ~dir
-                ~in_context
-                ~mode
-                ~src:(Path.build src)
-                ~obj_dir
-                ~config:None
+              List.map Jsoo_rules.Config.all ~f:(fun config ->
+                Jsoo_rules.build_cm
+                  sctx
+                  ~dir
+                  ~in_context
+                  ~mode
+                  ~src:(Path.build src)
+                  ~obj_dir
+                  ~config:(Some config))
             in
-            Super_context.add_rule sctx ~dir action_with_targets)))
+            Memo.parallel_iter action_with_targets ~f:(fun rule ->
+              Super_context.add_rule sctx ~dir rule))))
   in
   Memo.when_ melange (fun () ->
     let* () = build_cm ~cm_kind:(Melange Cmj) ~phase:None in

src/dune_rules/stanzas/library.mli

@@ -71,6 +71,7 @@ val foreign_lib_files
     declared in. *)
 val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t
 
+val archive_basename : t -> ext:string -> string
 val best_name : t -> Lib_name.t
 val is_virtual : t -> bool
 val is_impl : t -> bool

test/blackbox-tests/test-cases/jsoo/explicit-js-mode-specified.t/run.t

@@ -27,9 +27,11 @@ specify js mode (#1940).
    js_of_ocaml .e.eobjs/jsoo/e.bc.runtime.js
    js_of_ocaml .js/default/stdlib/std_exit.cmo.js
    js_of_ocaml .js/default/stdlib/stdlib.cma.js
-   js_of_ocaml .b.eobjs/jsoo/b.cmo.js
+   js_of_ocaml .foo.objs/jsoo/default/foo.cmo.js
+   js_of_ocaml .b.eobjs/jsoo/default/b.cmo.js
+   js_of_ocaml .foo.objs/jsoo/default/foo__C.cmo.js
    js_of_ocaml b.bc.js
-   js_of_ocaml .e.eobjs/jsoo/e.cmo.js
+   js_of_ocaml .e.eobjs/jsoo/default/e.cmo.js
    js_of_ocaml .foo.objs/jsoo/default/foo.cma.js
    js_of_ocaml e.bc.js