Skip to content

Commit

Permalink
fix(melange): resolve libraries lazily for melange.emit
Browse files Browse the repository at this point in the history
Signed-off-by: Antonio Nuno Monteiro <anmonteiro@gmail.com>
  • Loading branch information
anmonteiro committed Jun 3, 2023
1 parent fb328a7 commit 02b0af4
Show file tree
Hide file tree
Showing 4 changed files with 115 additions and 20 deletions.
71 changes: 53 additions & 18 deletions src/dune_rules/melange/melange_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -336,16 +336,16 @@ let setup_runtime_assets_rules sctx ~dir ~target_dir ~mode ~output ~for_ mel =
in
()

let setup_entries_js ~sctx ~dir ~dir_contents ~scope ~compile_info ~target_dir
~mode (mel : Melange_stanzas.Emit.t) =
let modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope
(mel : Melange_stanzas.Emit.t) =
let open Memo.O in
(* Use "mobjs" rather than "objs" to avoid a potential conflict with a library
of the same name *)
let* modules, obj_dir =
Dir_contents.ocaml dir_contents
>>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target })
in
let* modules =
let+ modules =
let version = (Super_context.context sctx).ocaml.version in
let* preprocess =
Resolve.Memo.read_memo
Expand All @@ -358,16 +358,24 @@ let setup_entries_js ~sctx ~dir ~dir_contents ~scope ~compile_info ~target_dir
in
Modules.map_user_written modules ~f:(fun m -> Memo.return @@ pped_map m)
in
let modules_for_js =
Modules.fold_no_vlib modules ~init:[] ~f:(fun x acc ->
if Module.has x ~ml_kind:Impl then x :: acc else acc)
in
(modules_for_js, obj_dir)

let setup_entries_js ~sctx ~dir ~dir_contents ~scope ~compile_info ~target_dir
~mode (mel : Melange_stanzas.Emit.t) =
let open Memo.O in
let* modules_for_js, obj_dir =
modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope mel
in
let requires_link = Lib.Compile.requires_link compile_info in
let pkg_name = Option.map mel.package ~f:Package.name in
let loc = mel.loc in
let module_systems = mel.module_systems in
let* requires_link = Memo.Lazy.force requires_link in
let includes = cmj_includes ~requires_link ~scope in
let modules_for_js =
Modules.fold_no_vlib modules ~init:[] ~f:(fun x acc ->
if Module.has x ~ml_kind:Impl then x :: acc else acc)
in
let output = `Private_library_or_emit target_dir in
let obj_dir = Obj_dir.of_local obj_dir in
let* () =
Expand Down Expand Up @@ -426,6 +434,18 @@ let setup_js_rules_libraries ~dir ~scope ~target_dir ~sctx ~requires_link ~mode
let* source_modules = impl_only_modules_defined_in_this_lib sctx lib in
Memo.parallel_iter source_modules ~f:(build_js ~dir ~output ~includes))

let setup_js_rules_libraries_and_entries ~dir_contents ~dir ~scope ~sctx
~compile_info ~requires_link ~mode ~target_dir mel =
let open Memo.O in
let+ () =
setup_js_rules_libraries ~dir ~scope ~target_dir ~sctx ~requires_link ~mode
mel
and+ () =
setup_entries_js ~sctx ~dir ~dir_contents ~scope ~compile_info ~target_dir
~mode mel
in
()

let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
let open Memo.O in
let target_dir =
Expand All @@ -437,15 +457,30 @@ let setup_emit_js_rules ~dir_contents ~dir ~scope ~sctx mel =
| Some p -> Promote p
in
let* compile_info = compile_info ~scope mel in
let+ () =
let* requires_link =
Lib.Compile.requires_link compile_info
|> Memo.Lazy.force >>= Resolve.read_memo
in
setup_js_rules_libraries ~dir ~scope ~target_dir ~sctx ~requires_link ~mode
mel
and+ () =
setup_entries_js ~sctx ~dir ~dir_contents ~scope ~compile_info ~target_dir
~mode mel
let* requires_link_resolve =
Lib.Compile.requires_link compile_info |> Memo.Lazy.force
in
()
match Resolve.to_result requires_link_resolve with
| Ok requires_link ->
setup_js_rules_libraries_and_entries ~dir_contents ~dir ~scope ~sctx
~compile_info ~requires_link ~mode ~target_dir mel
| Error resolve_error ->
(* NOTE: in multi-package projects where [melange.emit] stanzas are
present, we can't eagerly resolve the link-time closure for
[melange.emit] stanzas since their targets aren't public (i.e. part of a
package). When resolution fails, we replace the JS entries with the
resolution error inside [Action_builder.fail] to give Dune a chance to
fail if any of the targets end up attached to a package installation. *)
let* modules_for_js, _obj_dir =
modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope mel
and* () = Resolve.push_frames resolve_error in
let module_systems = mel.module_systems in
let output = `Private_library_or_emit target_dir in
let loc = mel.loc in
Memo.parallel_iter modules_for_js ~f:(fun m ->
Memo.parallel_iter module_systems ~f:(fun (_module_system, js_ext) ->
let file_targets = [ make_js_name ~output ~js_ext m ] in
Super_context.add_rule sctx ~dir ~loc ~mode
(Action_builder.fail
{ fail = (fun () -> Resolve.raise_error resolve_error) }
|> Action_builder.with_file_targets ~file_targets)))
12 changes: 12 additions & 0 deletions src/dune_rules/resolve.ml
Original file line number Diff line number Diff line change
Expand Up @@ -41,6 +41,18 @@ let to_result x = x

let of_error x = Error x

let raise_error ({ exn; _ } : error) = raise exn

let push_frames { stack_frames; exn = _ } =
let rec loop = function
| [] -> Memo.return ()
| x :: rest ->
Memo.push_stack_frame
~human_readable_description:(fun () -> Lazy.force x)
(fun () -> loop rest)
in
loop stack_frames

let error_to_memo { stack_frames; exn } =
let open Memo.O in
let rec loop = function
Expand Down
4 changes: 4 additions & 0 deletions src/dune_rules/resolve.mli
Original file line number Diff line number Diff line change
Expand Up @@ -108,6 +108,10 @@ type error

val to_result : 'a t -> ('a, error) result

val raise_error : error -> 'a

val push_frames : error -> unit Memo.t

val of_error : error -> 'a t

(** Read a [Resolve.t] value inside the action builder monad. *)
Expand Down
48 changes: 46 additions & 2 deletions test/blackbox-tests/test-cases/melange/melange-emit-package.t
Original file line number Diff line number Diff line change
Expand Up @@ -40,8 +40,52 @@
when building the other library
$ dune build -p my-ppx
File "test/dune", line 5, characters 12-19:
5 | (libraries mel-foo))
It still builds everything normally with the alias
$ dune build @melange
$ ls _build/default/test/js-out/test/
test_entry.js
Now define a 3rd lib that we'll use to preprocess the melange.emit entries:
$ dune clean
$ cat > dune-project <<EOF
> (lang dune 3.8)
> (package (name my-ppx))
> (package (name mel-foo))
> (package (name my-ppx2))
> (using melange 0.1)
> EOF
$ mkdir ppx2
$ cat > ppx2/dune <<EOF
> (library
> (name my_ppx2)
> (kind ppx_rewriter) (libraries ppxlib)
> (public_name my-ppx2))
> EOF
$ touch ppx2/my_ppx2.ml
$ cat > test/dune <<EOF
> (melange.emit
> (package mel-foo)
> (target js-out)
> (preprocess (pps my-ppx2))
> (emit_stdlib false)
> (libraries mel-foo))
> EOF
we can still build my-ppx independently
$ dune build -p my-ppx
and fails if it can't resolve libraries to build the alias
$ dune build @melange -p my-ppx
File "test/dune", line 6, characters 12-19:
6 | (libraries mel-foo))
^^^^^^^
Error: Library "mel-foo" not found.
-> required by _build/default/test/js-out/test/test_entry.js
-> required by alias test/melange
[1]

0 comments on commit 02b0af4

Please sign in to comment.