Jsoo shapes (#10767)

* Add support for jsoo shapes

Signed-off-by: Hugo Heuzard <[email protected]>

* read shapes for cmo.js

Signed-off-by: Hugo Heuzard <[email protected]>

* accept diff

Signed-off-by: Hugo Heuzard <[email protected]>

---------

Signed-off-by: Hugo Heuzard <[email protected]>

Author: hhugo

src/dune_rules/jsoo/jsoo_rules.ml

@@ -316,6 +316,15 @@ let wasmoo ~dir sctx =
     "wasm_of_ocaml"
 ;;
 
+let jsoo_has_shapes jsoo_version =
+  match jsoo_version with
+  | Some version ->
+    (match Version.compare version (6, 1) with
+     | Lt -> false
+     | Gt | Eq -> true)
+  | None -> false
+;;
+
 type sub_command =
   | Compile
   | Link
@@ -522,6 +531,12 @@ let jsoo_archives ~mode ctx config lib =
            ]))
 ;;
 
+let cmo_js_of_module ~mode m =
+  Module_name.Unique.artifact_filename
+    (Module.obj_name m)
+    ~ext:(Js_of_ocaml.Ext.cmo ~mode)
+;;
+
 let link_rule
       ~mode
       cc
@@ -537,11 +552,6 @@ let link_rule
   =
   let sctx = Compilation_context.super_context cc in
   let dir = Compilation_context.dir cc in
-  let mod_name m =
-    Module_name.Unique.artifact_filename
-      (Module.obj_name m)
-      ~ext:(Js_of_ocaml.Ext.cmo ~mode)
-  in
   let ctx = Super_context.context sctx |> Context.build_context in
   let get_all =
     let open Action_builder.O in
@@ -567,12 +577,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:None [ cmo_js_of_module ~mode 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:None [ cmo_js_of_module ~mode m ]))
     in
     let std_exit =
       Path.build
@@ -606,8 +617,25 @@ let link_rule
     ~sourcemap
 ;;
 
-let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap =
-  let spec = Command.Args.Dep src in
+let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~shapes ~sourcemap =
+  let spec =
+    Command.Args.(
+      S
+        [ Dep src
+        ; Dyn
+            (let open Action_builder.O in
+             let* jsoo_version =
+               let* jsoo = jsoo ~dir sctx in
+               Action_builder.of_memo @@ Version.jsoo_version jsoo
+             in
+             let+ shapes =
+               match jsoo_has_shapes jsoo_version with
+               | false -> Action_builder.return []
+               | true -> shapes
+             in
+             S (List.map shapes ~f:(fun s -> S [ A "--load-shape"; Dep s ])))
+        ])
+  in
   let flags = in_context.Js_of_ocaml.In_context.flags in
   js_of_ocaml_rule
     sctx
@@ -622,17 +650,38 @@ let build_cm' sctx ~dir ~in_context ~mode ~src ~target ~config ~sourcemap =
     ~sourcemap
 ;;
 
-let build_cm sctx ~dir ~in_context ~mode ~src ~obj_dir ~config =
+let build_cm cctx ~dir ~in_context ~mode ~src ~obj_dir ~deps ~config:config_opt =
   let name = with_js_ext ~mode (Path.basename src) in
-  let target = in_obj_dir ~obj_dir ~config [ name ] in
+  let target = in_obj_dir ~obj_dir ~config:config_opt [ name ] in
+  let sctx = Compilation_context.super_context cctx in
+  let ctx = Super_context.context sctx |> Context.build_context in
+  let shapes =
+    let open Action_builder.O in
+    let+ libs = Resolve.Memo.read (Compilation_context.requires_link cctx)
+    and+ deps = deps
+    and+ config =
+      match config_opt with
+      | None ->
+        let flags = in_context.Js_of_ocaml.In_context.flags in
+        js_of_ocaml_flags sctx ~dir ~mode flags
+        |> Action_builder.bind ~f:(fun (x : _ Js_of_ocaml.Flags.t) -> x.compile)
+        |> Action_builder.map ~f:Config.of_flags
+      | Some config -> Action_builder.return config
+    in
+    (Path.build (in_build_dir ctx ~config [ "stdlib"; with_js_ext ~mode "stdlib.cma" ])
+     :: List.concat_map libs ~f:(fun lib -> jsoo_archives ~mode ctx config lib))
+    @ List.map deps ~f:(fun m ->
+      Path.build (in_obj_dir ~obj_dir ~config:config_opt [ cmo_js_of_module ~mode m ]))
+  in
   build_cm'
     sctx
     ~dir
     ~in_context
     ~mode
     ~src
     ~target
-    ~config:(Option.map config ~f:Action_builder.return)
+    ~shapes
+    ~config:(Option.map config_opt ~f:Action_builder.return)
     ~sourcemap:Js_of_ocaml.Sourcemap.Inline
 ;;
 
@@ -649,6 +698,11 @@ let setup_separate_compilation_rules sctx components =
      | None -> Memo.return ()
      | Some pkg ->
        let info = Lib.info pkg in
+       let requires =
+         let open Resolve.Memo.O in
+         let* reqs = Lib.requires pkg in
+         Lib.closure ~linking:false reqs
+       in
        let lib_name = Lib_name.to_string (Lib.name pkg) in
        let* archives =
          let archives = (Lib_info.archives info).byte in
@@ -679,6 +733,23 @@ let setup_separate_compilation_rules sctx components =
            let target =
              in_build_dir build_context ~config [ lib_name; with_js_ext ~mode name ]
            in
+           let shapes =
+             let open Action_builder.O in
+             let+ requires = Resolve.Memo.read requires in
+             let l =
+               List.concat_map requires ~f:(fun lib ->
+                 jsoo_archives ~mode build_context config lib)
+             in
+             match lib_name with
+             | "stdlib" -> l
+             | _ ->
+               Path.build
+                 (in_build_dir
+                    build_context
+                    ~config
+                    [ "stdlib"; with_js_ext ~mode "stdlib.cma" ])
+               :: l
+           in
            build_cm'
              sctx
              ~dir
@@ -688,6 +759,7 @@ let setup_separate_compilation_rules sctx components =
              ~target
              ~config:(Some (Action_builder.return config))
              ~sourcemap:Js_of_ocaml.Sourcemap.Inline
+             ~shapes
            |> Super_context.add_rule sctx ~dir)))
 ;;
 

src/dune_rules/jsoo/jsoo_rules.mli

@@ -16,12 +16,13 @@ module Version : sig
 end
 
 val build_cm
-  :  Super_context.t
+  :  Compilation_context.t
   -> dir:Path.Build.t
   -> in_context:Js_of_ocaml.In_context.t
   -> mode:Js_of_ocaml.Mode.t
   -> src:Path.t
   -> obj_dir:Path.Build.t Obj_dir.t
+  -> deps:Module.t list Action_builder.t
   -> config:Config.t option
   -> Action.Full.t Action_builder.With_targets.t
 

src/dune_rules/lib_rules.ml

@@ -459,14 +459,15 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~
         let action_with_targets =
           List.map Jsoo_rules.Config.all ~f:(fun config ->
             Jsoo_rules.build_cm
-              sctx
+              cctx
               ~dir
               ~in_context:
                 (Js_of_ocaml.In_context.make ~dir lib.buildable.js_of_ocaml
                  |> Js_of_ocaml.Mode.Pair.select ~mode)
               ~mode
               ~config:(Some config)
               ~src:(Path.build src)
+              ~deps:(Action_builder.return [])
               ~obj_dir)
         in
         Memo.parallel_iter action_with_targets ~f:(fun rule ->

src/dune_rules/module_compilation.ml

@@ -311,6 +311,9 @@ let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m =
       match Obj_dir.Module.cm_file obj_dir m ~kind:(Ocaml Cmo) with
       | None -> Memo.return ()
       | Some src ->
+        let ml_kind = Ml_kind.Impl in
+        let dep_graph = Ml_kind.Dict.get (Compilation_context.dep_graphs cctx) ml_kind in
+        let module_deps = Dep_graph.deps_of dep_graph m in
         Memo.parallel_iter Js_of_ocaml.Mode.all ~f:(fun mode ->
           Compilation_context.js_of_ocaml cctx
           |> Js_of_ocaml.Mode.Pair.select ~mode
@@ -320,12 +323,13 @@ let build_module ?(force_write_cmi = false) ?(precompiled_cmi = false) cctx m =
             let dir = Compilation_context.dir cctx in
             let action_with_targets =
               Jsoo_rules.build_cm
-                sctx
+                cctx
                 ~dir
                 ~in_context
                 ~mode
                 ~src:(Path.build src)
                 ~obj_dir
+                ~deps:module_deps
                 ~config:None
             in
             Super_context.add_rule sctx ~dir action_with_targets)))

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

@@ -25,12 +25,12 @@ specify js mode (#1940).
   $ dune build --display short @@all 2>&1 | grep js_of_ocaml
    js_of_ocaml .b.eobjs/jsoo/b.bc.runtime.js
    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 .js/default/stdlib/std_exit.cmo.js
    js_of_ocaml .b.eobjs/jsoo/b.cmo.js
    js_of_ocaml b.bc.js
-   js_of_ocaml .e.eobjs/jsoo/e.cmo.js
    js_of_ocaml .foo.objs/jsoo/default/foo.cma.js
+   js_of_ocaml .e.eobjs/jsoo/e.cmo.js
    js_of_ocaml e.bc.js
 
 Check that building a JS-enabled executable that depends on a library works.

test/blackbox-tests/test-cases/jsoo/inline-tests.t/run.t

@@ -9,9 +9,9 @@ Run inline tests using node js
   $ dune runtest
   inline tests (Byte)
   inline tests (Byte)
-  Warning [missing-effects-backend]: your program contains effect handlers; you should probably run js_of_ocaml with option '--effects=cps'
   inline tests (Native)
   inline tests (Native)
+  Warning [missing-effects-backend]: your program contains effect handlers; you should probably run js_of_ocaml with option '--effects=cps'
   inline tests (JS)
   inline tests (JS)
 

test/blackbox-tests/test-cases/jsoo/no-check-prim.t/run.t

@@ -10,20 +10,20 @@ Compilation using jsoo
       ocamldep bin/.technologic.eobjs/z.impl.d
       ocamlopt lib/.x.objs/native/x__.{cmx,o}
         ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt}
-   js_of_ocaml .js/default/js_of_ocaml-compiler.runtime/jsoo_runtime.cma.js
-   js_of_ocaml .js/default/js_of_ocaml/js_of_ocaml.cma.js
-   js_of_ocaml .js/default/stdlib/std_exit.cmo.js
    js_of_ocaml .js/default/stdlib/stdlib.cma.js
+   js_of_ocaml .js/default/stdlib/std_exit.cmo.js
       ocamlopt lib/.x.objs/native/x__Y.{cmx,o}
         ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt}
+   js_of_ocaml .js/default/js_of_ocaml-compiler.runtime/jsoo_runtime.cma.js
       ocamlopt lib/.x.objs/native/x.{cmx,o}
         ocamlc bin/.technologic.eobjs/byte/z.{cmi,cmo,cmt}
         ocamlc lib/x.cma
+   js_of_ocaml .js/default/js_of_ocaml/js_of_ocaml.cma.js
       ocamlopt lib/x.{a,cmxa}
         ocamlc bin/.technologic.eobjs/byte/technologic.{cmi,cmo,cmt}
-   js_of_ocaml bin/.technologic.eobjs/jsoo/z.cmo.js
    js_of_ocaml lib/.x.objs/jsoo/default/x.cma.js
       ocamlopt lib/x.cmxs
+   js_of_ocaml bin/.technologic.eobjs/jsoo/z.cmo.js
    js_of_ocaml bin/.technologic.eobjs/jsoo/technologic.cmo.js
    js_of_ocaml bin/technologic.bc.js
   $ node ./_build/default/bin/technologic.bc.js

test/blackbox-tests/test-cases/wasmoo/no-check-prim.t/run.t

@@ -10,24 +10,24 @@ Compilation using WasmOO
       ocamldep bin/.technologic.eobjs/dune__exe__Z.impl.d
       ocamlopt lib/.x.objs/native/x__.{cmx,o}
         ocamlc lib/.x.objs/byte/x__Y.{cmi,cmo,cmt}
-  wasm_of_ocaml .js/default/js_of_ocaml-compiler.runtime/jsoo_runtime.wasma
-  wasm_of_ocaml .js/default/js_of_ocaml/js_of_ocaml.wasma
-  wasm_of_ocaml .js/default/stdlib/std_exit.wasmo
   wasm_of_ocaml .js/default/stdlib/stdlib.wasma
+  wasm_of_ocaml .js/default/stdlib/std_exit.wasmo
         ocamlc bin/.technologic.eobjs/byte/dune__exe.{cmi,cmo,cmt}
       ocamldep bin/.technologic.eobjs/dune__exe__Technologic.intf.d
       ocamlopt lib/.x.objs/native/x__Y.{cmx,o}
         ocamlc lib/.x.objs/byte/x.{cmi,cmo,cmt}
-  wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe.wasmo
+  wasm_of_ocaml .js/default/js_of_ocaml-compiler.runtime/jsoo_runtime.wasma
       ocamlopt lib/.x.objs/native/x.{cmx,o}
         ocamlc bin/.technologic.eobjs/byte/dune__exe__Technologic.{cmi,cmti}
         ocamlc lib/x.cma
         ocamlc bin/.technologic.eobjs/byte/dune__exe__Z.{cmi,cmo,cmt}
+  wasm_of_ocaml .js/default/js_of_ocaml/js_of_ocaml.wasma
       ocamlopt lib/x.{a,cmxa}
-  wasm_of_ocaml lib/.x.objs/jsoo/default/x.wasma
         ocamlc bin/.technologic.eobjs/byte/dune__exe__Technologic.{cmo,cmt}
-  wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe__Z.wasmo
+  wasm_of_ocaml lib/.x.objs/jsoo/default/x.wasma
       ocamlopt lib/x.cmxs
+  wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe.wasmo
+  wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe__Z.wasmo
   wasm_of_ocaml bin/.technologic.eobjs/jsoo/dune__exe__Technologic.wasmo
   wasm_of_ocaml bin/technologic.bc.wasm.{js,assets}
   $ node ./_build/default/bin/technologic.bc.wasm.js