diff --git a/src/dune_rules/melange/melange_rules.ml b/src/dune_rules/melange/melange_rules.ml index 1037baaded4..778005b4cb0 100644 --- a/src/dune_rules/melange/melange_rules.ml +++ b/src/dune_rules/melange/melange_rules.ml @@ -40,8 +40,22 @@ let make_js_name ~js_ext ~output m = Path.Build.relative dst_dir basename ;; -let impl_only_modules_defined_in_this_lib sctx lib = - let+ modules = Dir_contents.modules_of_lib sctx lib in +let modules_in_obj_dir ~sctx ~scope ~preprocess modules = + let* version = + let+ ocaml = Context.ocaml (Super_context.context sctx) in + ocaml.version + and* preprocess = + Resolve.Memo.read_memo + (Preprocess.Per_module.with_instrumentation + preprocess + ~instrumentation_backend:(Lib.DB.instrumentation_backend (Scope.libs scope))) + in + let pped_map = Staged.unstage (Preprocessing.pped_modules_map preprocess version) in + Modules.map_user_written modules ~f:(fun m -> Memo.return @@ pped_map m) +;; + +let impl_only_modules_defined_in_this_lib ~sctx ~scope lib = + let* modules = Dir_contents.modules_of_lib sctx lib in match modules with | None -> User_error.raise @@ -52,8 +66,12 @@ let impl_only_modules_defined_in_this_lib sctx lib = (Lib.name lib |> Lib_name.to_string) ] | Some modules -> + let info = Lib.info lib in + let+ modules = + let preprocess = Lib_info.preprocess info in + modules_in_obj_dir ~sctx ~scope ~preprocess modules + in let () = - let info = Lib.info lib in let modes = Lib_info.modes info in match modes.melange with | false -> @@ -69,8 +87,9 @@ let impl_only_modules_defined_in_this_lib sctx lib = ] | true -> () in - (* for a virtual library,this will return all modules *) - (Modules.split_by_lib modules).impl |> List.filter ~f:(Module.has ~ml_kind:Impl) + ( modules + , (* for a virtual library, this will return all modules *) + (Modules.split_by_lib modules).impl |> List.filter ~f:(Module.has ~ml_kind:Impl) ) ;; let cmj_glob = Glob.of_string_exn Loc.none "*.cmj" @@ -133,11 +152,11 @@ let js_targets_of_modules modules ~module_systems ~output = |> Path.Set.union_all ;; -let js_targets_of_libs sctx libs ~module_systems ~target_dir = +let js_targets_of_libs ~sctx ~scope ~module_systems ~target_dir libs = Resolve.Memo.List.concat_map module_systems ~f:(fun (_, js_ext) -> let open Memo.O in let of_lib lib = - let+ modules = impl_only_modules_defined_in_this_lib sctx lib in + let+ _, modules = impl_only_modules_defined_in_this_lib ~sctx ~scope lib in let output = output_of_lib ~target_dir lib in List.rev_map modules ~f:(fun m -> Path.build @@ make_js_name ~output ~js_ext m) in @@ -162,7 +181,7 @@ let build_js ~obj_dir ~sctx ~includes - ~local_modules + ~local_modules_and_obj_dir m = let open Memo.O in @@ -195,17 +214,24 @@ let build_js in With_targets.map_build command ~f:(fun command -> let open Action_builder.O in - let local_library_paths = - match local_modules with - | Some (modules, obj_dir) -> + match local_modules_and_obj_dir with + | Some (modules, obj_dir) -> + let paths = let+ module_deps = Dep_rules.immediate_deps_of m modules ~obj_dir ~ml_kind:Impl in - List.map module_deps ~f:(fun dep_m -> - Obj_dir.Module.cm_file_exn obj_dir dep_m ~kind:(Melange Cmj) |> Path.build) - | None -> Action_builder.return [] - in - Action_builder.dyn_paths_unit local_library_paths >>> command) + List.fold_left module_deps ~init:[] ~f:(fun acc dep_m -> + if Module.has dep_m ~ml_kind:Impl + then ( + let cmj_file = + let kind : Lib_mode.Cm_kind.t = Melange Cmj in + Obj_dir.Module.cm_file_exn obj_dir dep_m ~kind |> Path.build + in + cmj_file :: acc) + else acc) + in + Action_builder.dyn_paths_unit paths >>> command + | None -> command) in Super_context.add_rule sctx ~dir ~loc ~mode build) ;; @@ -302,7 +328,7 @@ let setup_emit_cmj_rules @@ let open Resolve.Memo.O in Compilation_context.requires_link cctx - >>= js_targets_of_libs sctx ~module_systems ~target_dir + >>= js_targets_of_libs ~sctx ~scope ~module_systems ~target_dir in Action_builder.paths deps in @@ -403,18 +429,7 @@ let modules_for_js_and_obj_dir ~sctx ~dir_contents ~scope (mel : Melange_stanzas Dir_contents.ocaml dir_contents >>| Ml_sources.modules_and_obj_dir ~for_:(Melange { target = mel.target }) in - let+ modules = - let* ocaml = Context.ocaml (Super_context.context sctx) in - let version = ocaml.version in - let* preprocess = - Resolve.Memo.read_memo - (Preprocess.Per_module.with_instrumentation - mel.preprocess - ~instrumentation_backend:(Lib.DB.instrumentation_backend (Scope.libs scope))) - in - let pped_map = Staged.unstage (Preprocessing.pped_modules_map preprocess version) in - Modules.map_user_written modules ~f:(fun m -> Memo.return @@ pped_map m) - in + let+ modules = modules_in_obj_dir ~sctx ~scope ~preprocess:mel.preprocess modules 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) @@ -448,7 +463,7 @@ let setup_entries_js setup_runtime_assets_rules sctx ~dir ~target_dir ~mode ~output ~for_:`Emit mel in Memo.parallel_iter modules_for_js ~f:(fun m -> - let local_modules = Some (local_modules, local_obj_dir) in + let local_modules_and_obj_dir = Some (local_modules, local_obj_dir) in build_js ~dir ~loc @@ -459,92 +474,103 @@ let setup_entries_js ~obj_dir ~sctx ~includes - ~local_modules + ~local_modules_and_obj_dir m) ;; -let setup_js_rules_libraries - ~dir - ~scope - ~target_dir - ~sctx - ~requires_link - ~mode - (mel : Melange_stanzas.Emit.t) - = - let build_js = build_js ~sctx ~mode ~module_systems:mel.module_systems in - Memo.parallel_iter requires_link ~f:(fun lib -> - let open Memo.O in - let lib_compile_info = - Lib.Compile.for_lib - ~allow_overlaps:mel.allow_overlapping_dependencies - (Scope.libs scope) - lib - in - let info = Lib.info lib in - let loc = Lib_info.loc info in - let build_js = - let obj_dir = Lib_info.obj_dir info in - let pkg_name = Lib_info.package info in - build_js ~loc ~pkg_name ~obj_dir - in - let output = output_of_lib ~target_dir lib in - let* includes = - let+ requires_link = Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) in - cmj_includes ~requires_link ~scope - and* local_modules = - match Lib.Local.of_lib lib with - | Some lib -> - let+ modules = Dir_contents.modules_of_local_lib sctx lib in - let obj_dir = Lib.Local.obj_dir lib in - Some (modules, obj_dir) - | None -> Memo.return None - and* () = - setup_runtime_assets_rules - sctx - ~dir - ~target_dir - ~mode - ~output - ~for_:(`Library info) - mel +let setup_js_rules_libraries = + let local_modules_and_obj_dir ~lib modules = + Lib.Local.of_lib lib + |> Option.map ~f:(fun lib -> + let obj_dir = Lib.Local.obj_dir lib in + modules, obj_dir) + in + let parallel_build_source_modules ~sctx ~scope ~f lib = + let* local_modules_and_obj_dir, source_modules = + let+ lib_modules, source_modules = + impl_only_modules_defined_in_this_lib ~sctx ~scope lib + in + local_modules_and_obj_dir ~lib lib_modules, source_modules in - let* () = - match Lib.implements lib with - | None -> Memo.return () - | Some vlib -> - let* vlib = Resolve.Memo.read_memo vlib in - let* includes = - let+ requires_link = + Memo.parallel_iter source_modules ~f:(f ~local_modules_and_obj_dir) + in + fun ~dir ~scope ~target_dir ~sctx ~requires_link ~mode (mel : Melange_stanzas.Emit.t) -> + let build_js = build_js ~sctx ~mode ~module_systems:mel.module_systems in + Memo.parallel_iter requires_link ~f:(fun lib -> + let open Memo.O in + let lib_compile_info = + Lib.Compile.for_lib + ~allow_overlaps:mel.allow_overlapping_dependencies + (Scope.libs scope) + lib + in + let info = Lib.info lib in + let loc = Lib_info.loc info in + let build_js = + let obj_dir = Lib_info.obj_dir info in + let pkg_name = Lib_info.package info in + build_js ~loc ~pkg_name ~obj_dir + in + let output = output_of_lib ~target_dir lib in + let* includes = + let+ requires_link = + Memo.Lazy.force (Lib.Compile.requires_link lib_compile_info) + in + cmj_includes ~requires_link ~scope + in + let+ () = + setup_runtime_assets_rules + sctx + ~dir + ~target_dir + ~mode + ~output + ~for_:(`Library info) + mel + and+ () = + match Lib.implements lib with + | None -> Memo.return () + | Some vlib -> + let* vlib = Resolve.Memo.read_memo vlib in + let* includes = let+ requires_link = - Lib.Compile.for_lib - ~allow_overlaps:mel.allow_overlapping_dependencies - (Scope.libs scope) - vlib - |> Lib.Compile.requires_link - |> Memo.Lazy.force - in - let open Resolve.O in - let+ requires_link = requires_link in - (* Whenever a `concrete_lib` implementation contains a field - `(implements virt_lib)`, we also set up the JS targets for the - modules defined in `virt_lib`. + let+ requires_link = + Lib.Compile.for_lib + ~allow_overlaps:mel.allow_overlapping_dependencies + (Scope.libs scope) + vlib + |> Lib.Compile.requires_link + |> Memo.Lazy.force + in + let open Resolve.O in + let+ requires_link = requires_link in + (* Whenever a `concrete_lib` implementation contains a field + `(implements virt_lib)`, we also set up the JS targets for the + modules defined in `virt_lib`. - In the cases where `virt_lib` (concrete) modules depend on any - virtual modules (i.e. programming against the interface), we - need to make sure that the JS rules that dune emits for - `virt_lib` depend on `concrete_lib`, such that Melange can find - the correct `.cmj` file, which is needed to emit the correct - path in `import` / `require`. *) - lib :: requires_link + In the cases where `virt_lib` (concrete) modules depend on any + virtual modules (i.e. programming against the interface), we + need to make sure that the JS rules that dune emits for + `virt_lib` depend on `concrete_lib`, such that Melange can find + the correct `.cmj` file, which is needed to emit the correct + path in `import` / `require`. *) + lib :: requires_link + in + cmj_includes ~requires_link ~scope in - cmj_includes ~requires_link ~scope - in - impl_only_modules_defined_in_this_lib sctx vlib - >>= Memo.parallel_iter ~f:(build_js ~dir ~output ~includes ~local_modules) - in - let* source_modules = impl_only_modules_defined_in_this_lib sctx lib in - Memo.parallel_iter source_modules ~f:(build_js ~dir ~output ~local_modules ~includes)) + parallel_build_source_modules + ~sctx + ~scope + vlib + ~f:(build_js ~dir ~output ~includes) + and+ () = + parallel_build_source_modules + ~sctx + ~scope + lib + ~f:(build_js ~dir ~output ~includes) + in + ()) ;; let setup_js_rules_libraries_and_entries diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index 3d823e2ae99..7788038b68d 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -92,7 +92,7 @@ val visibility : t -> Visibility.t val encode : t -> src_dir:Path.t -> Dune_lang.t list val decode : src_dir:Path.t -> t Dune_lang.Decoder.t -(** [pped m] return [m] but with the preprocessed source paths paths *) +(** [pped m] return [m] but with the preprocessed source paths *) val pped : t -> t (** [ml_source m] returns [m] but with the OCaml syntax source paths *) diff --git a/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t new file mode 100644 index 00000000000..83bbb457c80 --- /dev/null +++ b/test/blackbox-tests/test-cases/melange/unexpected-ocamldep-output.t @@ -0,0 +1,43 @@ +Show that `melange.emit` + correct dependency tracking reads the processed +file after any dialects have run + + $ cat > dune-project < (lang dune 3.11) + > (using melange 0.1) + > (dialect + > (name myd) + > (implementation + > (preprocess (run cat %{input-file})) + > (extension myd))) + > EOF + $ cat > dune < (melange.emit + > (target output) + > (alias mel) + > (libraries foo) + > (emit_stdlib false)) + > EOF + $ mkdir lib + $ cat > lib/dune < (library + > (name foo) + > (modes melange)) + > EOF + $ cat > lib/foo.myd < let name = Bar.name + > EOF + $ cat > lib/bar.ml < let name = "Zoe" + > EOF + $ dune build @mel + +Now try preprocessing too + + $ dune clean + $ cat > lib/dune < (library + > (name foo) + > (preprocess (action (run cat %{input-file}))) + > (modes melange)) + > EOF + $ dune build @mel