From 6a9a212eb2e03428fcb1fc2cfab928dc87326ff1 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Mon, 26 May 2025 18:05:29 +0100 Subject: [PATCH 01/23] chore: set the parametized to wrapped Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/stanzas/parameter.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dune_rules/stanzas/parameter.ml b/src/dune_rules/stanzas/parameter.ml index 9669d17832f..24172f66514 100644 --- a/src/dune_rules/stanzas/parameter.ml +++ b/src/dune_rules/stanzas/parameter.ml @@ -27,7 +27,7 @@ let to_library t = ; library_flags = Ordered_set_lang.Unexpanded.standard ; c_library_flags = Ordered_set_lang.Unexpanded.standard ; virtual_deps = [] - ; wrapped = This (Simple false) + ; wrapped = This (Simple true) ; buildable = t.buildable ; dynlink = Dynlink_supported.of_bool false ; project = t.project From 8905390746dfd21c617d1f9d0fbd4608487ca890 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 27 May 2025 11:34:30 +0100 Subject: [PATCH 02/23] feat(tmp): Singleton working version of parameterized library This version works only in the singleton case at it aggressively add the module implements to all the module. In the case of the singleton it will break. Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 11 +++++++---- src/dune_rules/lib_rules.ml | 13 +++++++++++++ src/dune_rules/module.ml | 13 +++++++++---- src/dune_rules/module.mli | 2 ++ src/dune_rules/module_compilation.ml | 5 +++++ src/dune_rules/virtual_rules.ml | 2 +- 6 files changed, 37 insertions(+), 9 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 759dcae4fbd..a4cef1a5561 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -947,12 +947,15 @@ end = struct let open Resolve.Memo.O in let* vlib = resolve_forbid_ignore name in let virtual_ = Lib_info.virtual_ vlib.info in - match virtual_ with - | false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info - | true -> Resolve.Memo.return vlib + let parameterized = Lib_info.is_parameter vlib.info in + let _ = Format.printf "- (%s) Is\n%s\n----\n parameterized? %b@." __LOC__ (Lib_info.to_dyn Path.to_dyn vlib.info |> Dyn.to_string) parameterized in + match virtual_, parameterized with + | false,false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info + | true, false | false, true -> Resolve.Memo.return vlib + | true, true -> failwith "TODO @maiste" in Memo.map res ~f:Option.some - in + in let* requires = let requires = let open Resolve.O in diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index e8d3a0e132a..30e1faa20ef 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -500,6 +500,19 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ scope source_modules in + let* modules = + match vimpl with + | None -> Memo.return modules + | Some vimpl -> + let lib = Vimpl.vlib vimpl in + let* module_name = + let+ name = Lib.main_module_name lib in + match name |> Resolve.to_result with + | Ok (Some name) -> name + | _ -> failwith "TODO: Module name" + in + Modules.map_user_written ~f:(fun m -> Memo.return @@ Module.set_implements m module_name ) modules + in let modules = Vimpl.impl_modules vimpl modules in let requires_compile = Lib.Compile.direct_requires compile_info in let requires_link = Lib.Compile.requires_link compile_info in diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index ada39d63387..3ea7de0532c 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -202,6 +202,7 @@ type t = ; visibility : Visibility.t ; kind : Kind.t ; install_as : Path.Local.t option + ; implements : Module_name.t option } let name t = Source.name t.source @@ -209,6 +210,9 @@ let path t = t.source.path let kind t = t.kind let pp_flags t = t.pp let install_as t = t.install_as +let implements t = t.implements + +let set_implements t name = { t with implements = Some name} let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Source.t) = (match kind, visibility with @@ -245,7 +249,7 @@ let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Sourc indication by the caller. *) Module_name.Unique.of_path_assuming_needs_no_mangling_allow_invalid file.path in - { install_as; source; obj_name; pp = None; visibility; kind } + { install_as; source; obj_name; pp = None; visibility; kind ; implements = None } ;; let has t ~ml_kind = @@ -288,7 +292,8 @@ let map_files t ~f = let src_dir t = Source.src_dir t.source let set_pp t pp = { t with pp } -let to_dyn { source; obj_name; pp; visibility; kind; install_as } = +(* TODO @maiste encoding *) +let to_dyn { source; obj_name; pp; visibility; kind; install_as ; _ } = Dyn.record [ "source", Source.to_dyn source ; "obj_name", Module_name.Unique.to_dyn obj_name @@ -345,7 +350,7 @@ module Obj_map = struct end) end -let encode ({ source; obj_name; pp = _; visibility; kind; install_as = _ } as t) ~src_dir = +let encode ({ source; obj_name; pp = _; visibility; kind; install_as = _ ; _ } as t) ~src_dir = let open Dune_lang.Encoder in let has_impl = has t ~ml_kind:Impl in let kind = @@ -382,7 +387,7 @@ let decode ~src_dir = | None when Option.is_some source.files.impl -> Impl | None -> Intf_only in - { install_as = None; source; obj_name; pp = None; kind; visibility }) + { install_as = None; source; obj_name; pp = None; kind; visibility; implements = None }) ;; let pped = diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index b95cf62cbc6..655e1b1830d 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -51,6 +51,7 @@ val of_source : visibility:Visibility.t -> kind:Kind.t -> Source.t -> t val name : t -> Module_name.t val path : t -> Module_name.Path.t +val implements : t -> Module_name.t option val source : t -> ml_kind:Ml_kind.t -> File.t option val pp_flags : t -> (string list Action_builder.t * Sandbox_config.t) option val install_as : t -> Path.Local.t option @@ -62,6 +63,7 @@ val set_obj_name : t -> Module_name.Unique.t -> t val set_path : t -> Module_name.Path.t -> t val add_file : t -> Ml_kind.t -> File.t -> t val set_source : t -> Ml_kind.t -> File.t option -> t +val set_implements : t -> Module_name.t -> t (** Set preprocessing flags *) val set_pp : t -> (string list Action_builder.t * Sandbox_config.t) option -> t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index b438fd900f4..9ffda06c006 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -238,6 +238,10 @@ let build_cm else Command.Args.empty in let as_parameter_arg = if Module.kind m = Parameter then [ "-as-parameter" ] else [] in + let as_argument_for = match Module.implements m with + | None -> [] + | Some module_name -> [ "-as-argument-for" ; Module_name.to_string module_name] + in let flags, sandbox = let flags = Command.Args.dyn (Ocaml_flags.get (Compilation_context.flags cctx) mode) @@ -291,6 +295,7 @@ let build_cm (Lib_mode.Cm_kind.Map.get (Compilation_context.includes cctx) cm_kind) ; extra_args ; As as_parameter_arg + ; As as_argument_for ; S (melange_args cctx cm_kind m) ; A "-no-alias-deps" ; opaque_arg diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 8e3e6c45fd1..6539e2380cf 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -79,7 +79,7 @@ let impl sctx ~(lib : Library.t) ~scope = ] | Some vlib -> let info = Lib.info vlib in - if not (Lib_info.virtual_ info) + if not (Lib_info.virtual_ info) && not (Lib_info.is_parameter info) then User_error.raise ~loc:lib.buildable.loc From 5d6b8696e061b9e498ddccfd0b8a5b724ba1a8bc Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 27 May 2025 14:40:22 +0100 Subject: [PATCH 03/23] feat(tmp): support other library kind for parameterized library This commit extends the support to find the root module from the library name which must always exists locally because we declare the implementation. Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib_rules.ml | 45 +++++++++++++++++++++++++++---------- 1 file changed, 33 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 30e1faa20ef..8a337d11ade 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -487,6 +487,27 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ (fun () -> build_shared ~native_archives ~sctx lib ~dir ~flags) ;; +let parameterize_root_module ~parameter ~root_module_name modules = + let* parameter_module_name = + let+ name = Lib.main_module_name parameter in + match Resolve.to_result name with + | Ok (Some name) -> name + | Ok None -> + (* The parameter must have a module name otherwise it can't exist. *) + assert false + | Error err -> Resolve.raise_error_with_stack_trace err + in + let set_implements_for_root_module m = + (* If the module name is the one of the root module, it must implements the + parameter. *) + Memo.return + (match Module_name.equal (Module.name m) root_module_name with + | true -> Module.set_implements m parameter_module_name + | false -> m) + in + Modules.map_user_written ~f:set_implements_for_root_module modules +;; + let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = let* flags = Buildable_rules.ocaml_flags sctx ~dir lib.buildable.flags and* vimpl = Virtual_rules.impl sctx ~lib ~scope in @@ -500,18 +521,18 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ scope source_modules in - let* modules = - match vimpl with - | None -> Memo.return modules - | Some vimpl -> - let lib = Vimpl.vlib vimpl in - let* module_name = - let+ name = Lib.main_module_name lib in - match name |> Resolve.to_result with - | Ok (Some name) -> name - | _ -> failwith "TODO: Module name" - in - Modules.map_user_written ~f:(fun m -> Memo.return @@ Module.set_implements m module_name ) modules + let* modules = + match vimpl with + | None -> Memo.return modules + | Some vimpl -> + let vlib = Vimpl.vlib vimpl in + if Lib_info.is_parameter @@ Lib.info vlib + then ( + let root_module_name = lib.name |> Module_name.of_local_lib_name in + (* The root module can be extracted because the implementation must be + local to Dune *) + parameterize_root_module ~parameter:vlib ~root_module_name modules) + else Memo.return modules in let modules = Vimpl.impl_modules vimpl modules in let requires_compile = Lib.Compile.direct_requires compile_info in From 010c233bdb931dccb8f0c0e976ec7192409e86b9 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Thu, 3 Jul 2025 15:41:58 +0200 Subject: [PATCH 04/23] fix: rebase remove useless print Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index a4cef1a5561..58055d8c2bd 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -948,7 +948,6 @@ end = struct let* vlib = resolve_forbid_ignore name in let virtual_ = Lib_info.virtual_ vlib.info in let parameterized = Lib_info.is_parameter vlib.info in - let _ = Format.printf "- (%s) Is\n%s\n----\n parameterized? %b@." __LOC__ (Lib_info.to_dyn Path.to_dyn vlib.info |> Dyn.to_string) parameterized in match virtual_, parameterized with | false,false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info | true, false | false, true -> Resolve.Memo.return vlib From c4578473e045aa5f5befa8bec860ac1f56bda3b5 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Fri, 4 Jul 2025 15:33:13 +0200 Subject: [PATCH 05/23] test: add implementation tests Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- .../test-cases/oxcaml/helpers.sh | 28 +++++++ .../test-cases/oxcaml/implements-parameter.t | 84 +++++++++++++++++++ 2 files changed, 112 insertions(+) create mode 100644 test/blackbox-tests/test-cases/oxcaml/implements-parameter.t diff --git a/test/blackbox-tests/test-cases/oxcaml/helpers.sh b/test/blackbox-tests/test-cases/oxcaml/helpers.sh index 2ae043cb0b5..de4c91cf3ea 100644 --- a/test/blackbox-tests/test-cases/oxcaml/helpers.sh +++ b/test/blackbox-tests/test-cases/oxcaml/helpers.sh @@ -13,6 +13,34 @@ make_dir_with_dune() { cat > "$path/dune" } +make_dummy_intf() { + dir="$1" + name="$2" + cat >> "$dir/$name.mli" < unit +EOF +} + +make_dummy_impl() { + dir="$1" + name="$2" + cat >> "$dir/$name.ml" < (library_parameter + > (public_name foo)) + > EOF + $ make_dummy_intf "foo" "foo" + $ cat >> dune-project << EOF + > (package (name foo)) + > EOF + + $ make_dir_with_dune "bar" < (library_parameter + > (name bar)) + > EOF + $ make_dummy_intf "bar" "bar" + + $ dune build $(target_cmi "bar") + $ dune build $(target_cmi "foo") + +We implement the parameter using a library. + +TODO(@maiste): creating a public package generate a bug! + + $ rm -rf _build + $ cat >> dune-project << EOF + > (package (name foo_impl)) + > EOF + $ make_dir_with_dune "foo_impl" < (library + > (public_name foo_impl) + > (implements foo)) + > EOF + $ make_dummy_impl "foo_impl" "foo_impl" + $ dune build + +We create library implementing the parameter with a bigger interface than what +the parameter expects. + + $ rm -rf _build + $ echo "let ignore_me = 42" >> foo_impl/foo_impl.ml + + $ dune build + +We add a library implementing a parameter with the wrong interface. + + $ rm -rf _build + $ echo "type t = int" > foo_impl/foo_impl.ml + + $ dune build + File "foo_impl/foo_impl.ml", line 1: + Error: The argument module foo_impl/foo_impl.ml + does not match the parameter signature foo/.foo.objs/byte/foo.cmi: + The value f is required but not provided + File "foo/foo.mli", line 2, characters 0-17: Expected declaration + [1] + +A library implementing the parameter, but importing the content from other files. + + $ rm -rf _build + + $ echo "type t = int" > foo_impl/aux_type.ml + $ echo "type t" > foo_impl/aux_type.mli + + $ echo "let f _ = ()" > foo_impl/aux_impl.ml + $ echo "val f: Aux_type.t -> unit" > foo_impl/aux_impl.mli + + $ cat > foo_impl/foo_impl.ml < include Aux_type + > include Aux_impl + > EOF + $ dune build + +We ensure we have all the necessary information for the impletamentation to be used with findlib. + + $ dune build @install + $ cat _build/install/foo_impl/foo_impl/dune-package From c78c9b2c5b8373d12124a7fe7b66b051c5a0efd9 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Mon, 7 Jul 2025 16:13:26 +0200 Subject: [PATCH 06/23] test: check both private and public lib work Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- .../test-cases/oxcaml/implements-parameter.t | 20 +++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index 6ffa1e599c8..429bee2d26e 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -27,9 +27,17 @@ We create two parameters, on public, the other one local. We implement the parameter using a library. -TODO(@maiste): creating a public package generate a bug! - $ rm -rf _build + $ make_dir_with_dune "foo_impl" < (library + > (name foo_impl) + > (implements foo)) + > EOF + $ make_dummy_impl "foo_impl" "foo_impl" + $ dune build + +We change the implementation to be public instead of a local one. + $ cat >> dune-project << EOF > (package (name foo_impl)) > EOF @@ -38,7 +46,6 @@ TODO(@maiste): creating a public package generate a bug! > (public_name foo_impl) > (implements foo)) > EOF - $ make_dummy_impl "foo_impl" "foo_impl" $ dune build We create library implementing the parameter with a bigger interface than what @@ -57,8 +64,8 @@ We add a library implementing a parameter with the wrong interface. $ dune build File "foo_impl/foo_impl.ml", line 1: Error: The argument module foo_impl/foo_impl.ml - does not match the parameter signature foo/.foo.objs/byte/foo.cmi: - The value f is required but not provided + does not match the parameter signature foo_impl/.foo_impl.objs/byte/foo.cmi: + The value f is required but not provided File "foo/foo.mli", line 2, characters 0-17: Expected declaration [1] @@ -81,4 +88,5 @@ A library implementing the parameter, but importing the content from other files We ensure we have all the necessary information for the impletamentation to be used with findlib. $ dune build @install - $ cat _build/install/foo_impl/foo_impl/dune-package + $ cat _build/install/default/lib/foo_impl/dune-package | grep "implements" + (implements foo) From 60ba6e7dd5d7c5e39ce0d954dff0c536c2544a42 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Mon, 7 Jul 2025 16:17:36 +0200 Subject: [PATCH 07/23] fix: change parameter public lib behavior Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 58055d8c2bd..9dda8bb6c6c 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -724,8 +724,9 @@ end = struct let rec loop acc = function | [] -> Resolve.Memo.return acc | (lib, stack) :: libs -> + let is_parameter = Lib_info.is_parameter lib.info in let virtual_ = Lib_info.virtual_ lib.info in - (match lib.implements, virtual_ with + (match lib.implements, virtual_ || is_parameter with | None, false -> loop acc libs | Some _, true -> assert false (* can't be virtual and implement *) | None, true -> loop (Map.set acc lib (No_impl stack)) libs @@ -949,12 +950,12 @@ end = struct let virtual_ = Lib_info.virtual_ vlib.info in let parameterized = Lib_info.is_parameter vlib.info in match virtual_, parameterized with - | false,false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info + | false, false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info | true, false | false, true -> Resolve.Memo.return vlib | true, true -> failwith "TODO @maiste" in Memo.map res ~f:Option.some - in + in let* requires = let requires = let open Resolve.O in From 78b9abf61e6a5337ac58c92d92bae99e0d26c44b Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Mon, 7 Jul 2025 16:17:41 +0200 Subject: [PATCH 08/23] chore(fmt): apply dune formatter Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/module.ml | 21 +++++++++++++++------ src/dune_rules/module_compilation.ml | 9 +++++---- src/dune_rules/virtual_rules.ml | 2 +- 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index 3ea7de0532c..f9397a42a5b 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -211,8 +211,7 @@ let kind t = t.kind let pp_flags t = t.pp let install_as t = t.install_as let implements t = t.implements - -let set_implements t name = { t with implements = Some name} +let set_implements t name = { t with implements = Some name } let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Source.t) = (match kind, visibility with @@ -249,7 +248,7 @@ let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Sourc indication by the caller. *) Module_name.Unique.of_path_assuming_needs_no_mangling_allow_invalid file.path in - { install_as; source; obj_name; pp = None; visibility; kind ; implements = None } + { install_as; source; obj_name; pp = None; visibility; kind; implements = None } ;; let has t ~ml_kind = @@ -293,7 +292,7 @@ let src_dir t = Source.src_dir t.source let set_pp t pp = { t with pp } (* TODO @maiste encoding *) -let to_dyn { source; obj_name; pp; visibility; kind; install_as ; _ } = +let to_dyn { source; obj_name; pp; visibility; kind; install_as; _ } = Dyn.record [ "source", Source.to_dyn source ; "obj_name", Module_name.Unique.to_dyn obj_name @@ -350,7 +349,10 @@ module Obj_map = struct end) end -let encode ({ source; obj_name; pp = _; visibility; kind; install_as = _ ; _ } as t) ~src_dir = +let encode + ({ source; obj_name; pp = _; visibility; kind; install_as = _; _ } as t) + ~src_dir + = let open Dune_lang.Encoder in let has_impl = has t ~ml_kind:Impl in let kind = @@ -387,7 +389,14 @@ let decode ~src_dir = | None when Option.is_some source.files.impl -> Impl | None -> Intf_only in - { install_as = None; source; obj_name; pp = None; kind; visibility; implements = None }) + { install_as = None + ; source + ; obj_name + ; pp = None + ; kind + ; visibility + ; implements = None + }) ;; let pped = diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 9ffda06c006..cd79a853d58 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -238,10 +238,11 @@ let build_cm else Command.Args.empty in let as_parameter_arg = if Module.kind m = Parameter then [ "-as-parameter" ] else [] in - let as_argument_for = match Module.implements m with - | None -> [] - | Some module_name -> [ "-as-argument-for" ; Module_name.to_string module_name] - in + let as_argument_for = + match Module.implements m with + | None -> [] + | Some module_name -> [ "-as-argument-for"; Module_name.to_string module_name ] + in let flags, sandbox = let flags = Command.Args.dyn (Ocaml_flags.get (Compilation_context.flags cctx) mode) diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 6539e2380cf..01a142fb3a2 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -79,7 +79,7 @@ let impl sctx ~(lib : Library.t) ~scope = ] | Some vlib -> let info = Lib.info vlib in - if not (Lib_info.virtual_ info) && not (Lib_info.is_parameter info) + if (not (Lib_info.virtual_ info)) && not (Lib_info.is_parameter info) then User_error.raise ~loc:lib.buildable.loc From 5d67d9a5ef86fafd2ef8dfd05ea45938b70ca359 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Mon, 7 Jul 2025 17:45:17 +0200 Subject: [PATCH 09/23] doc: add implementation documentation Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- doc/reference/dune/library.rst | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/doc/reference/dune/library.rst b/doc/reference/dune/library.rst index 01a964507d4..497952c3a1f 100644 --- a/doc/reference/dune/library.rst +++ b/doc/reference/dune/library.rst @@ -210,6 +210,13 @@ order to declare a multi-directory library, you need to use the unless you use Dune to synthesize the ``depends`` and ``depopts`` sections of your opam file. +.. describe:: (implements ) + + ``name`` defines the name of the virtual library or the parameter you are + implementing. + + See :doc:`/virtual-libraries` or :doc:`/reference/dune/library_parameter`. + .. describe:: (js_of_ocaml ...) Sets options for JavaScript compilation, see :ref:`jsoo-field`. From 74e97339a210326c012685449e82e73b5579dacf Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 8 Jul 2025 16:27:17 +0200 Subject: [PATCH 10/23] chore: fix error message for impossible case Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 6 +++++- src/dune_rules/module.ml | 1 - 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 9dda8bb6c6c..d3dab31446c 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -952,7 +952,11 @@ end = struct match virtual_, parameterized with | false, false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info | true, false | false, true -> Resolve.Memo.return vlib - | true, true -> failwith "TODO @maiste" + | true, true -> + Code_error.raise + "A virtual library can't be a parameter or a parameter can't be a virtual \ + library by construction" + [] in Memo.map res ~f:Option.some in diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index f9397a42a5b..c08d1c0e883 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -291,7 +291,6 @@ let map_files t ~f = let src_dir t = Source.src_dir t.source let set_pp t pp = { t with pp } -(* TODO @maiste encoding *) let to_dyn { source; obj_name; pp; visibility; kind; install_as; _ } = Dyn.record [ "source", Source.to_dyn source From c598b265cf303ebed21f739978740d5d38515cc1 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Wed, 9 Jul 2025 09:57:40 +0200 Subject: [PATCH 11/23] test(promote): now export the main module (unique module) Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- test/blackbox-tests/test-cases/oxcaml/library_parameter.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/test/blackbox-tests/test-cases/oxcaml/library_parameter.t b/test/blackbox-tests/test-cases/oxcaml/library_parameter.t index 2b91861ff48..b34ee24b62c 100644 --- a/test/blackbox-tests/test-cases/oxcaml/library_parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/library_parameter.t @@ -155,6 +155,7 @@ parameters. (library (name param.intf) (kind parameter) + (main_module_name Param_intf) (modes byte) (modules (singleton @@ -165,6 +166,7 @@ parameters. (library (name param.intf2) (kind parameter) + (main_module_name Param_intf2) (modes byte) (modules (singleton From 5d7bf1f53f319ee447253841fd18c9ffe679df55 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Wed, 9 Jul 2025 14:11:25 +0200 Subject: [PATCH 12/23] chore: add explnation comment for change Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/stanzas/parameter.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/dune_rules/stanzas/parameter.ml b/src/dune_rules/stanzas/parameter.ml index 24172f66514..b7a1690e05a 100644 --- a/src/dune_rules/stanzas/parameter.ml +++ b/src/dune_rules/stanzas/parameter.ml @@ -27,7 +27,9 @@ let to_library t = ; library_flags = Ordered_set_lang.Unexpanded.standard ; c_library_flags = Ordered_set_lang.Unexpanded.standard ; virtual_deps = [] - ; wrapped = This (Simple true) + ; wrapped = + This (Simple true) + (* We set it as Simple true because, otherwise, we can extract the Singleton main module name. *) ; buildable = t.buildable ; dynlink = Dynlink_supported.of_bool false ; project = t.project From bda4be2f1fa965bdda8d6daf17c2c1947c8ef485 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Thu, 10 Jul 2025 14:14:33 +0200 Subject: [PATCH 13/23] chore(review): apply @art-w review Signed-off-by: Etienne Marais Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 4 ++-- src/dune_rules/stanzas/parameter.ml | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index d3dab31446c..f507f3a583f 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -948,8 +948,8 @@ end = struct let open Resolve.Memo.O in let* vlib = resolve_forbid_ignore name in let virtual_ = Lib_info.virtual_ vlib.info in - let parameterized = Lib_info.is_parameter vlib.info in - match virtual_, parameterized with + let is_parameter = Lib_info.is_parameter vlib.info in + match virtual_, is_parameter with | false, false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info | true, false | false, true -> Resolve.Memo.return vlib | true, true -> diff --git a/src/dune_rules/stanzas/parameter.ml b/src/dune_rules/stanzas/parameter.ml index b7a1690e05a..587bb9d1855 100644 --- a/src/dune_rules/stanzas/parameter.ml +++ b/src/dune_rules/stanzas/parameter.ml @@ -29,7 +29,8 @@ let to_library t = ; virtual_deps = [] ; wrapped = This (Simple true) - (* We set it as Simple true because, otherwise, we can extract the Singleton main module name. *) + (* We set it as Simple true because, otherwise, we can't extract the + Singleton main module name. *) ; buildable = t.buildable ; dynlink = Dynlink_supported.of_bool false ; project = t.project From 1f71be2de854493ac3592144aa93e5d13ce9c860 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 22 Jul 2025 12:04:18 +0200 Subject: [PATCH 14/23] test: check for nonexistent parameter Signed-off-by: Etienne Marais --- .../test-cases/oxcaml/implements-parameter.t | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index 429bee2d26e..fcb54495c8d 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -25,12 +25,22 @@ We create two parameters, on public, the other one local. $ dune build $(target_cmi "bar") $ dune build $(target_cmi "foo") -We implement the parameter using a library. +We implements the parameter using library calling a wrong parameter name. $ rm -rf _build $ make_dir_with_dune "foo_impl" < (library > (name foo_impl) + > (implements missing_foo)) + > EOF + $ dune build + +We implement the parameter using a library with a correct parameter this time. + + $ rm -rf _build foo_impl + $ make_dir_with_dune "foo_impl" < (library + > (name foo_impl) > (implements foo)) > EOF $ make_dummy_impl "foo_impl" "foo_impl" From 741095e978840f8d348d4d11418fbd1a3d1ea5e3 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 22 Jul 2025 14:30:43 +0200 Subject: [PATCH 15/23] test: implement a non parameter library Signed-off-by: Etienne Marais --- src/dune_rules/lib.ml | 3 ++- .../test-cases/oxcaml/implements-parameter.t | 23 ++++++++++++++++++- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index f507f3a583f..9063a8d06fa 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -241,7 +241,8 @@ module Error = struct make ~loc [ Pp.textf - "Library %S is not virtual. It cannot be implemented by %S." + "Library %S is not virtual nor a library parameter. It cannot be implemented \ + by %S." (Lib_name.to_string not_vlib) (Lib_name.to_string impl) ] diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index fcb54495c8d..a449603a942 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -25,7 +25,18 @@ We create two parameters, on public, the other one local. $ dune build $(target_cmi "bar") $ dune build $(target_cmi "foo") -We implements the parameter using library calling a wrong parameter name. + $ make_dir_with_dune "foo_lib" < (library + > (name foo_lib)) + > EOF + $ cat > "foo_lib/foo_lib.ml" < let x = 42 + > EOF + $ dune build + + +We implements a non parameter library (neither a virtual module). It should +fail with the correct error message. $ rm -rf _build $ make_dir_with_dune "foo_impl" < EOF $ dune build +We implements the parameter using library calling a wrong parameter name. + + $ rm -rf _build foo_impl + $ make_dir_with_dune "foo_impl" < (library + > (name foo_impl) + > (implements missing_foo)) + > EOF + $ dune build + We implement the parameter using a library with a correct parameter this time. $ rm -rf _build foo_impl From 0812eb6ccc8755d6a537b4bc28b846dfb8a73242 Mon Sep 17 00:00:00 2001 From: Etienne Marais Date: Tue, 22 Jul 2025 15:26:35 +0200 Subject: [PATCH 16/23] test: apply promotion Signed-off-by: Etienne Marais --- .../test-cases/oxcaml/implements-parameter.t | 12 ++++++++++++ .../virtual-libraries/impl-not-virtual-external.t | 3 ++- .../virtual-libraries/impl-not-virtual.t/run.t | 3 ++- 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index a449603a942..ce74d6babd2 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -45,6 +45,12 @@ fail with the correct error message. > (implements missing_foo)) > EOF $ dune build + File "foo_impl/dune", line 3, characters 13-24: + 3 | (implements missing_foo)) + ^^^^^^^^^^^ + Error: Library "missing_foo" not found. + -> required by alias default + [1] We implements the parameter using library calling a wrong parameter name. @@ -55,6 +61,12 @@ We implements the parameter using library calling a wrong parameter name. > (implements missing_foo)) > EOF $ dune build + File "foo_impl/dune", line 3, characters 13-24: + 3 | (implements missing_foo)) + ^^^^^^^^^^^ + Error: Library "missing_foo" not found. + -> required by alias default + [1] We implement the parameter using a library with a correct parameter this time. diff --git a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t index 4e9ea999c58..0de6edcd310 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t @@ -20,6 +20,7 @@ an appropriate error message. File "dune", line 1, characters 21-29: 1 | (library (implements foodummy) (name bar)) ^^^^^^^^ - Error: Library "foodummy" is not virtual. It cannot be implemented by "bar". + Error: Library "foodummy" is not virtual nor a library parameter. It cannot + be implemented by "bar". Leaving directory 'test' [1] diff --git a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t index 2939ecab44d..0fd0b68d6a2 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t @@ -4,6 +4,7 @@ appropriate error message. File "impl/dune", line 3, characters 13-16: 3 | (implements lib)) ^^^ - Error: Library "lib" is not virtual. It cannot be implemented by "impl". + Error: Library "lib" is not virtual nor a library parameter. It cannot be + implemented by "impl". -> required by alias default in dune:1 [1] From 7fff1871da94e25d12afd8ce0ca71f396a9e7f2c Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Mon, 25 Aug 2025 20:27:09 -0400 Subject: [PATCH 17/23] remove [Library.is_parameter] Signed-off-by: Shon Feder --- src/dune_rules/install_rules.ml | 46 +++++++++++++++--------------- src/dune_rules/lib_rules.ml | 8 +++--- src/dune_rules/ml_sources.ml | 14 +++++---- src/dune_rules/stanzas/library.ml | 8 ++++-- src/dune_rules/stanzas/library.mli | 1 - 5 files changed, 40 insertions(+), 37 deletions(-) diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index de0211b7e1a..f9f610760a3 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -266,7 +266,6 @@ end = struct let { Lib_mode.Map.ocaml = { Mode.Dict.byte; native } as ocaml; melange } = Mode_conf.Lib.Set.eval lib.modes ~has_native in - let is_parameter = Library.is_parameter lib in let+ melange_runtime_entries = additional_deps lib.melange_runtime_deps and+ public_headers = additional_deps lib.public_headers and+ module_files = @@ -293,26 +292,27 @@ end = struct | Some f -> [ cm_kind, f ]) else [] in - let common = - let virtual_library = Library.is_virtual lib in - fun m -> - let cm_file kind = Obj_dir.Module.cm_file obj_dir m ~kind in - let open Lib_mode.Cm_kind in - let cmi = if_ (native || byte) (Ocaml Cmi, cm_file (Ocaml Cmi)) in - let rest = - if is_parameter - then [] - else - [ if_ native (Ocaml Cmx, cm_file (Ocaml Cmx)) - ; if_ (byte && virtual_library) (Ocaml Cmo, cm_file (Ocaml Cmo)) - ; if_ - (native && virtual_library) - (Ocaml Cmx, Obj_dir.Module.o_file obj_dir m ~ext_obj) - ; if_ melange (Melange Cmi, cm_file (Melange Cmi)) - ; if_ melange (Melange Cmj, cm_file (Melange Cmj)) + let common m = + let cm_file kind = Obj_dir.Module.cm_file obj_dir m ~kind in + let open Lib_mode.Cm_kind in + let cmi = if_ (native || byte) (Ocaml Cmi, cm_file (Ocaml Cmi)) in + let common_module_impls virtual_only = + (if_ native (Ocaml Cmx, cm_file (Ocaml Cmx)) :: virtual_only) + @ [ if_ melange (Melange Cmi, cm_file (Melange Cmi)) + ; if_ melange (Melange Cmj, cm_file (Melange Cmj)) + ] + in + let rest = + match (lib.kind : Lib_kind.t) with + | Parameter -> [] + | Virtual -> + common_module_impls + [ if_ byte (Ocaml Cmo, cm_file (Ocaml Cmo)) + ; if_ native (Ocaml Cmx, Obj_dir.Module.o_file obj_dir m ~ext_obj) ] - in - cmi :: rest |> List.rev_concat + | _ -> common_module_impls [] + in + cmi :: rest |> List.rev_concat in let set_dir m = List.rev_map ~f:(fun (cm_kind, p) -> cm_dir m cm_kind, p) in let+ modules_impl = @@ -354,9 +354,9 @@ end = struct [ sources ; melange_runtime_entries ; List.rev_map module_files ~f:(fun (sub_dir, file) -> make_entry ?sub_dir Lib file) - ; (match is_parameter with - | true -> [] - | false -> + ; (match lib.kind with + | Parameter -> [] + | Virtual | Dune_file _ -> List.rev_concat [ List.rev_map lib_files ~f:(fun (section, file) -> make_entry section file) ; List.rev_map execs ~f:(make_entry Libexec) diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 8a337d11ade..6404ee55ef9 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -443,9 +443,9 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ Lib_info.eval_native_archives_exn lib_info ~modules:(Some modules) in let* () = - if Library.is_parameter lib - then Memo.return () - else ( + match lib.kind with + | Parameter -> Memo.return () + | Virtual | Dune_file _ -> let cm_files = let excluded_modules = (* ctypes type_gen and function_gen scripts should not be included in the @@ -457,7 +457,7 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ Cm_files.make ~excluded_modules ~obj_dir ~ext_obj ~modules ~top_sorted_modules () in iter_modes_concurrently modes.ocaml ~f:(fun mode -> - build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~cm_files)) + build_lib lib ~native_archives ~dir ~sctx ~expander ~flags ~mode ~cm_files) and* () = (* Build *.cma.js / *.wasma *) Memo.when_ modes.ocaml.byte (fun () -> diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 0787ecc3107..3a11dcef62a 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -364,9 +364,10 @@ let make_lib_modules | From _ -> assert false in let kind : Modules_field_evaluator.kind = - match lib.virtual_modules with - | None -> if Library.is_parameter lib then Parameter else Exe_or_normal_lib - | Some virtual_modules -> Virtual { virtual_modules } + match lib.virtual_modules, lib.kind with + | None, Parameter -> Parameter + | None, _ -> Exe_or_normal_lib + | Some virtual_modules, _ -> Virtual { virtual_modules } in Memo.return (Resolve.return (kind, main_module_name, wrapped)) | Some _ -> @@ -427,11 +428,12 @@ let make_lib_modules | _, _ -> () in let () = - if Library.is_parameter lib && Option.is_none (Module_trie.as_singleton modules) - then + match lib.kind, Module_trie.as_singleton modules with + | Parameter, None -> User_error.raise ~loc:lib.buildable.loc - [ Pp.text "a library_parameter can't declare more than one module." ] + [ Pp.text "a library_parameter must declare exactly one module." ] + | _ -> () in let implements = Option.is_some lib.implements in let _loc, lib_name = lib.name in diff --git a/src/dune_rules/stanzas/library.ml b/src/dune_rules/stanzas/library.ml index b3a563bb6fb..1d29bf375d2 100644 --- a/src/dune_rules/stanzas/library.ml +++ b/src/dune_rules/stanzas/library.ml @@ -394,7 +394,6 @@ let best_name t = | Public p -> snd p.name ;; -let is_parameter t = t.kind = Parameter let is_virtual t = t.kind = Virtual let is_impl t = Option.is_some t.implements @@ -456,8 +455,11 @@ let to_lib_info let archive ?(dir = dir) ext = archive conf ~dir ~ext in let modes = Mode_conf.Lib.Set.eval ~has_native conf.modes in let archive_for_mode ~f_ext ~mode = - if Mode.Dict.get modes.ocaml mode && not (is_parameter conf) - then Some (archive (f_ext mode)) + if Mode.Dict.get modes.ocaml mode + then ( + match conf.kind with + | Parameter -> None + | Virtual | Dune_file _ -> Some (archive (f_ext mode))) else None in let archives_for_mode ~f_ext = diff --git a/src/dune_rules/stanzas/library.mli b/src/dune_rules/stanzas/library.mli index 702b037fe08..6119f2aa107 100644 --- a/src/dune_rules/stanzas/library.mli +++ b/src/dune_rules/stanzas/library.mli @@ -73,7 +73,6 @@ val archive : t -> dir:Path.Build.t -> ext:string -> Path.Build.t val best_name : t -> Lib_name.t val is_virtual : t -> bool -val is_parameter : t -> bool val is_impl : t -> bool val obj_dir : dir:Path.Build.t -> t -> Path.Build.t Obj_dir.t val main_module_name : t -> Lib_info.Main_module_name.t From e04a928a72c6008ec2d3e2d209d64da506a4cdd1 Mon Sep 17 00:00:00 2001 From: Shon Feder Date: Mon, 25 Aug 2025 20:34:55 -0400 Subject: [PATCH 18/23] documentation and comment fixes Signed-off-by: Shon Feder --- doc/reference/dune/library.rst | 4 ++-- src/dune_rules/lib.ml | 4 ++-- .../test-cases/oxcaml/implements-parameter.t | 8 ++++---- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/doc/reference/dune/library.rst b/doc/reference/dune/library.rst index 497952c3a1f..2f58b99380c 100644 --- a/doc/reference/dune/library.rst +++ b/doc/reference/dune/library.rst @@ -212,8 +212,8 @@ order to declare a multi-directory library, you need to use the .. describe:: (implements ) - ``name`` defines the name of the virtual library or the parameter you are - implementing. + ``name`` defines the name of the virtual library or the parameter library you + are implementing. See :doc:`/virtual-libraries` or :doc:`/reference/dune/library_parameter`. diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 9063a8d06fa..7e72321826b 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -241,8 +241,8 @@ module Error = struct make ~loc [ Pp.textf - "Library %S is not virtual nor a library parameter. It cannot be implemented \ - by %S." + "Library %S is neither a virtual nor a library nor a library parameter. It \ + cannot be implemented by %S." (Lib_name.to_string not_vlib) (Lib_name.to_string impl) ] diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index ce74d6babd2..687a757a705 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -3,7 +3,7 @@ parameterized libraries. $ . ./helpers.sh -We create two parameters, on public, the other one local. +We create two parameters, one public, the other one local. $ init_project @@ -35,8 +35,8 @@ We create two parameters, on public, the other one local. $ dune build -We implements a non parameter library (neither a virtual module). It should -fail with the correct error message. +Trying to implement a non-parameter and non-virtual library should fail with the +correct error message. $ rm -rf _build $ make_dir_with_dune "foo_impl" < required by alias default [1] -We implements the parameter using library calling a wrong parameter name. +We implement the parameter using a library calling a wrong parameter name. $ rm -rf _build foo_impl $ make_dir_with_dune "foo_impl" < Date: Thu, 4 Sep 2025 10:14:37 +0200 Subject: [PATCH 19/23] test: add more edge cases Signed-off-by: ArthurW --- src/dune_rules/lib.ml | 4 +- .../test-cases/oxcaml/implements-parameter.t | 168 +++++++++++++----- .../test-cases/oxcaml/library_parameter.t | 4 +- .../impl-not-virtual-external.t | 4 +- .../impl-not-virtual.t/run.t | 4 +- 5 files changed, 136 insertions(+), 48 deletions(-) diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 7e72321826b..86768519e34 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -241,8 +241,8 @@ module Error = struct make ~loc [ Pp.textf - "Library %S is neither a virtual nor a library nor a library parameter. It \ - cannot be implemented by %S." + "Library %S is neither a virtual library nor a library parameter. It cannot be \ + implemented by %S." (Lib_name.to_string not_vlib) (Lib_name.to_string impl) ] diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index 687a757a705..2e05d134122 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -3,42 +3,25 @@ parameterized libraries. $ . ./helpers.sh -We create two parameters, one public, the other one local. +We create a public parameter: $ init_project - $ make_dir_with_dune "foo" < (library_parameter - > (public_name foo)) - > EOF - $ make_dummy_intf "foo" "foo" $ cat >> dune-project << EOF - > (package (name foo)) + > (package (name public_foo)) > EOF - $ make_dir_with_dune "bar" < (library_parameter - > (name bar)) + > (public_name public_foo) + > (name foo)) > EOF - $ make_dummy_intf "bar" "bar" + $ make_dummy_intf "foo" "foo" - $ dune build $(target_cmi "bar") $ dune build $(target_cmi "foo") - $ make_dir_with_dune "foo_lib" < (library - > (name foo_lib)) - > EOF - $ cat > "foo_lib/foo_lib.ml" < let x = 42 - > EOF - $ dune build - - -Trying to implement a non-parameter and non-virtual library should fail with the -correct error message. +It should fail if we try to implement an unknown library: - $ rm -rf _build $ make_dir_with_dune "foo_impl" < (library > (name foo_impl) @@ -52,25 +35,33 @@ correct error message. -> required by alias default [1] -We implement the parameter using a library calling a wrong parameter name. +It should also fail if we try to implement a library that is neither a +parameter nor virtual: - $ rm -rf _build foo_impl + $ make_dir_with_dune "a_standard_lib" < (library + > (name a_standard_lib)) + > EOF + + $ rm -rf foo_impl $ make_dir_with_dune "foo_impl" < (library > (name foo_impl) - > (implements missing_foo)) + > (implements a_standard_lib)) > EOF + $ dune build - File "foo_impl/dune", line 3, characters 13-24: - 3 | (implements missing_foo)) - ^^^^^^^^^^^ - Error: Library "missing_foo" not found. + File "foo_impl/dune", line 3, characters 13-27: + 3 | (implements a_standard_lib)) + ^^^^^^^^^^^^^^ + Error: Library "a_standard_lib" is neither a virtual library nor a library + parameter. It cannot be implemented by "foo_impl". -> required by alias default [1] We implement the parameter using a library with a correct parameter this time. - $ rm -rf _build foo_impl + $ rm -rf foo_impl $ make_dir_with_dune "foo_impl" < (library > (name foo_impl) @@ -79,6 +70,19 @@ We implement the parameter using a library with a correct parameter this time. $ make_dummy_impl "foo_impl" "foo_impl" $ dune build +The implementation can use multiple files, as long as the root module satisfies +the parameter interface: + + $ cat > foo_impl/foo_impl.ml < type t = string + > let f = Util.f + > EOF + $ cat > foo_impl/util.ml < let f = print_endline + > EOF + + $ dune build + We change the implementation to be public instead of a local one. $ cat >> dune-project << EOF @@ -91,17 +95,16 @@ We change the implementation to be public instead of a local one. > EOF $ dune build -We create library implementing the parameter with a bigger interface than what +We create a library implementing the parameter with a bigger interface than what the parameter expects. - $ rm -rf _build $ echo "let ignore_me = 42" >> foo_impl/foo_impl.ml $ dune build -We add a library implementing a parameter with the wrong interface. +The compiler will signal an error if the library doesn't implement the required +interface: - $ rm -rf _build $ echo "type t = int" > foo_impl/foo_impl.ml $ dune build @@ -114,8 +117,6 @@ We add a library implementing a parameter with the wrong interface. A library implementing the parameter, but importing the content from other files. - $ rm -rf _build - $ echo "type t = int" > foo_impl/aux_type.ml $ echo "type t" > foo_impl/aux_type.mli @@ -128,8 +129,95 @@ A library implementing the parameter, but importing the content from other files > EOF $ dune build -We ensure we have all the necessary information for the impletamentation to be used with findlib. +We ensure we have all the necessary information for the implementation to be +used with findlib. It should use the public name of the parameter: $ dune build @install $ cat _build/install/default/lib/foo_impl/dune-package | grep "implements" - (implements foo) + (implements public_foo) + +We introduce a new parameter that is not public: + + $ make_dir_with_dune "bar" < (library_parameter + > (name bar)) + > EOF + $ make_dummy_intf "bar" "bar" + +A private library can implement this private parameter: + + $ make_dir_with_dune "bar_impl" < (library + > (name bar_impl) + > (implements bar)) + > EOF + $ make_dummy_impl "bar_impl" "bar_impl" + $ dune build + +We can check that the right flag was given to the compiler with ocamlobjinfo: + + $ ocamlobjinfo _build/default/bar_impl/bar_impl.cma | grep 'Parameter' + Parameter implemented: Bar + +A private library can also implement a public parameter: + + $ cat > bar_impl/dune < (library + > (name bar_impl) + > (implements foo)) + > EOF + $ dune build + + $ ocamlobjinfo _build/default/bar_impl/bar_impl.cma | grep Parameter + Parameter implemented: Foo + +But it's an error for a public library to implement a private parameter: + + $ cat >> dune-project << EOF + > (package (name bar_impl)) + > EOF + $ rm -rf bar_impl + $ make_dir_with_dune "bar_impl" < (library + > (public_name bar_impl) + > (implements bar)) + > EOF + $ dune build + File "bar_impl/dune", line 3, characters 13-16: + 3 | (implements bar)) + ^^^ + Error: Library "bar" is private, it cannot be a dependency of a public + library. You need to give "bar" a public name. + [1] + +It's impossible for a library to implement two parameters: + + $ rm -rf bar_impl + $ make_dir_with_dune "bar_impl" < (library + > (name bar_impl) + > (implements foo bar)) + > EOF + $ dune build + File "bar_impl/dune", line 3, characters 17-20: + 3 | (implements foo bar)) + ^^^ + Error: Too many arguments for "implements" + [1] + +An unwrapped library can't implement a parameter: + + $ rm -rf bar_impl + $ make_dir_with_dune "bar_impl" < (library + > (name bar_impl) + > (wrapped false) + > (implements bar)) + > EOF + $ dune build + File "bar_impl/dune", line 3, characters 10-15: + 3 | (wrapped false) + ^^^^^ + Error: Wrapped cannot be set for implementations. It is inherited from the + virtual library. + [1] diff --git a/test/blackbox-tests/test-cases/oxcaml/library_parameter.t b/test/blackbox-tests/test-cases/oxcaml/library_parameter.t index b34ee24b62c..c97d4bb0c3b 100644 --- a/test/blackbox-tests/test-cases/oxcaml/library_parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/library_parameter.t @@ -85,7 +85,7 @@ limit the parameter to one module now. 2 | (public_name multiple_param) 3 | (name multiple_param) 4 | (modules multiple_param data)) - Error: a library_parameter can't declare more than one module. + Error: a library_parameter must declare exactly one module. [1] We make sure the same happened if multiple modules exists in one directory. @@ -100,7 +100,7 @@ We make sure the same happened if multiple modules exists in one directory. 1 | (library_parameter 2 | (public_name multiple_param) 3 | (name multiple_param)) - Error: a library_parameter can't declare more than one module. + Error: a library_parameter must declare exactly one module. [1] We build the installable version to ensure we have generated the correct diff --git a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t index 0de6edcd310..f85f3dc01b5 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual-external.t @@ -20,7 +20,7 @@ an appropriate error message. File "dune", line 1, characters 21-29: 1 | (library (implements foodummy) (name bar)) ^^^^^^^^ - Error: Library "foodummy" is not virtual nor a library parameter. It cannot - be implemented by "bar". + Error: Library "foodummy" is neither a virtual library nor a library + parameter. It cannot be implemented by "bar". Leaving directory 'test' [1] diff --git a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t index 0fd0b68d6a2..a5759006c19 100644 --- a/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t +++ b/test/blackbox-tests/test-cases/virtual-libraries/impl-not-virtual.t/run.t @@ -4,7 +4,7 @@ appropriate error message. File "impl/dune", line 3, characters 13-16: 3 | (implements lib)) ^^^ - Error: Library "lib" is not virtual nor a library parameter. It cannot be - implemented by "impl". + Error: Library "lib" is neither a virtual library nor a library parameter. It + cannot be implemented by "impl". -> required by alias default in dune:1 [1] From 1f393faa1ccc297545552efb4e47617594eea899 Mon Sep 17 00:00:00 2001 From: ArthurW Date: Thu, 4 Sep 2025 10:52:50 +0200 Subject: [PATCH 20/23] refactor: move module implements to compilation context Signed-off-by: ArthurW --- src/dune_rules/compilation_context.ml | 9 ++++++ src/dune_rules/compilation_context.mli | 2 ++ src/dune_rules/lib_rules.ml | 38 ++++++-------------------- src/dune_rules/module.ml | 14 ++-------- src/dune_rules/module.mli | 2 -- src/dune_rules/module_compilation.ml | 13 ++++++--- 6 files changed, 30 insertions(+), 48 deletions(-) diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 31ad378b113..c49ee3fa265 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -87,6 +87,7 @@ type t = ; requires_compile : Lib.t list Resolve.Memo.t ; requires_hidden : Lib.t list Resolve.Memo.t ; requires_link : Lib.t list Resolve.t Memo.Lazy.t + ; implements_parameter : (Module_name.t * Module_name.t option Resolve.Memo.t) option ; includes : Includes.t ; preprocessing : Pp_spec.t ; opaque : bool @@ -128,6 +129,12 @@ let context t = Super_context.context t.super_context let dep_graphs t = t.modules.dep_graphs let ocaml t = t.ocaml +let implements_parameter t m = + match t.implements_parameter with + | Some (root, implements) when Module_name.equal root (Module.name m) -> implements + | _ -> Resolve.Memo.return None +;; + let create ~super_context ~scope @@ -136,6 +143,7 @@ let create ~flags ~requires_compile ~requires_link + ?implements_parameter ?(preprocessing = Pp_spec.dummy) ~opaque ?stdlib @@ -200,6 +208,7 @@ let create ; requires_compile = direct_requires ; requires_hidden = hidden_requires ; requires_link + ; implements_parameter ; includes = Includes.make ~project ~opaque ~direct_requires ~hidden_requires ocaml.lib_config ; preprocessing diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 92c58a9da25..15c5be1e147 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -27,6 +27,7 @@ val create -> flags:Ocaml_flags.t -> requires_compile:Lib.t list Resolve.Memo.t -> requires_link:Lib.t list Resolve.t Memo.Lazy.t + -> ?implements_parameter:Module_name.t * Module_name.t option Resolve.Memo.t -> ?preprocessing:Pp_spec.t -> opaque:opaque -> ?stdlib:Ocaml_stdlib.t @@ -57,6 +58,7 @@ val flags : t -> Ocaml_flags.t val requires_link : t -> Lib.t list Resolve.Memo.t val requires_hidden : t -> Lib.t list Resolve.Memo.t val requires_compile : t -> Lib.t list Resolve.Memo.t +val implements_parameter : t -> Module.t -> Module_name.t option Resolve.Memo.t val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t val preprocessing : t -> Pp_spec.t val opaque : t -> bool diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 6404ee55ef9..f707fc64b27 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -487,27 +487,6 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ (fun () -> build_shared ~native_archives ~sctx lib ~dir ~flags) ;; -let parameterize_root_module ~parameter ~root_module_name modules = - let* parameter_module_name = - let+ name = Lib.main_module_name parameter in - match Resolve.to_result name with - | Ok (Some name) -> name - | Ok None -> - (* The parameter must have a module name otherwise it can't exist. *) - assert false - | Error err -> Resolve.raise_error_with_stack_trace err - in - let set_implements_for_root_module m = - (* If the module name is the one of the root module, it must implements the - parameter. *) - Memo.return - (match Module_name.equal (Module.name m) root_module_name with - | true -> Module.set_implements m parameter_module_name - | false -> m) - in - Modules.map_user_written ~f:set_implements_for_root_module modules -;; - let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = let* flags = Buildable_rules.ocaml_flags sctx ~dir lib.buildable.flags and* vimpl = Virtual_rules.impl sctx ~lib ~scope in @@ -521,18 +500,16 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ scope source_modules in - let* modules = + let implements_parameter = match vimpl with - | None -> Memo.return modules + | None -> None | Some vimpl -> let vlib = Vimpl.vlib vimpl in - if Lib_info.is_parameter @@ Lib.info vlib - then ( - let root_module_name = lib.name |> Module_name.of_local_lib_name in - (* The root module can be extracted because the implementation must be - local to Dune *) - parameterize_root_module ~parameter:vlib ~root_module_name modules) - else Memo.return modules + (match Lib_info.kind (Lib.info vlib) with + | Parameter -> + let root_module = Module_name.of_local_lib_name lib.name in + Some (root_module, Lib.main_module_name vlib) + | _ -> None) in let modules = Vimpl.impl_modules vimpl modules in let requires_compile = Lib.Compile.direct_requires compile_info in @@ -567,6 +544,7 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ ~flags ~requires_compile ~requires_link + ?implements_parameter ~preprocessing:pp ~opaque:Inherit_from_settings ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.map ~f:Option.some js_of_ocaml) diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index c08d1c0e883..fc13a52d799 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -202,7 +202,6 @@ type t = ; visibility : Visibility.t ; kind : Kind.t ; install_as : Path.Local.t option - ; implements : Module_name.t option } let name t = Source.name t.source @@ -210,8 +209,6 @@ let path t = t.source.path let kind t = t.kind let pp_flags t = t.pp let install_as t = t.install_as -let implements t = t.implements -let set_implements t name = { t with implements = Some name } let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Source.t) = (match kind, visibility with @@ -248,7 +245,7 @@ let of_source ~install_as ~obj_name ~visibility ~(kind : Kind.t) (source : Sourc indication by the caller. *) Module_name.Unique.of_path_assuming_needs_no_mangling_allow_invalid file.path in - { install_as; source; obj_name; pp = None; visibility; kind; implements = None } + { install_as; source; obj_name; pp = None; visibility; kind } ;; let has t ~ml_kind = @@ -388,14 +385,7 @@ let decode ~src_dir = | None when Option.is_some source.files.impl -> Impl | None -> Intf_only in - { install_as = None - ; source - ; obj_name - ; pp = None - ; kind - ; visibility - ; implements = None - }) + { install_as = None; source; obj_name; pp = None; kind; visibility }) ;; let pped = diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index 655e1b1830d..b95cf62cbc6 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -51,7 +51,6 @@ val of_source : visibility:Visibility.t -> kind:Kind.t -> Source.t -> t val name : t -> Module_name.t val path : t -> Module_name.Path.t -val implements : t -> Module_name.t option val source : t -> ml_kind:Ml_kind.t -> File.t option val pp_flags : t -> (string list Action_builder.t * Sandbox_config.t) option val install_as : t -> Path.Local.t option @@ -63,7 +62,6 @@ val set_obj_name : t -> Module_name.Unique.t -> t val set_path : t -> Module_name.Path.t -> t val add_file : t -> Ml_kind.t -> File.t -> t val set_source : t -> Ml_kind.t -> File.t option -> t -val set_implements : t -> Module_name.t -> t (** Set preprocessing flags *) val set_pp : t -> (string list Action_builder.t * Sandbox_config.t) option -> t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index cd79a853d58..7c2e7c63611 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -239,9 +239,14 @@ let build_cm in let as_parameter_arg = if Module.kind m = Parameter then [ "-as-parameter" ] else [] in let as_argument_for = - match Module.implements m with - | None -> [] - | Some module_name -> [ "-as-argument-for"; Module_name.to_string module_name ] + Command.Args.dyn + (let open Action_builder.O in + let+ argument = + Resolve.Memo.read @@ Compilation_context.implements_parameter cctx m + in + match argument with + | None -> [] + | Some parameter -> [ "-as-argument-for"; Module_name.to_string parameter ]) in let flags, sandbox = let flags = @@ -296,7 +301,7 @@ let build_cm (Lib_mode.Cm_kind.Map.get (Compilation_context.includes cctx) cm_kind) ; extra_args ; As as_parameter_arg - ; As as_argument_for + ; as_argument_for ; S (melange_args cctx cm_kind m) ; A "-no-alias-deps" ; opaque_arg From 2049059f4358af3f0bd65d88e58f681f6d567cae Mon Sep 17 00:00:00 2001 From: ArthurW Date: Thu, 4 Sep 2025 11:55:55 +0200 Subject: [PATCH 21/23] refactor: replace usage of is_parameter by match kind Signed-off-by: ArthurW --- src/dune_rules/install_rules.ml | 12 +++++++----- src/dune_rules/lib.ml | 26 +++++++++----------------- src/dune_rules/ml_sources.ml | 9 +++++---- src/dune_rules/virtual_rules.ml | 17 +++++++++-------- 4 files changed, 30 insertions(+), 34 deletions(-) diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index f9f610760a3..ebd1ae50bc9 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -97,9 +97,10 @@ end = struct >>| Modules.With_vlib.modules >>| Option.some and+ foreign_archives = - match Lib_info.virtual_ lib with - | false -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) - | true -> + match Lib_info.kind lib with + | Dune_file _ -> + Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) + | Parameter | Virtual -> let+ foreign_sources = Dir_contents.foreign_sources dir_contents in let name = Lib_info.name lib in let files = Foreign_sources.for_lib foreign_sources ~name in @@ -837,8 +838,9 @@ end = struct let* { Scope.DB.Lib_entry.Set.libraries; _ } = Action_builder.of_memo entries in match List.find_map libraries ~f:(fun lib -> - let info = Lib.Local.info lib in - Option.some_if (Lib_info.virtual_ info) lib) + match Lib_info.kind (Lib.Local.info lib) with + | Parameter | Virtual -> Some lib + | Dune_file _ -> None) with | None -> Action_builder.lines_of meta_template | Some vlib -> diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 86768519e34..e87305dcc37 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -725,13 +725,12 @@ end = struct let rec loop acc = function | [] -> Resolve.Memo.return acc | (lib, stack) :: libs -> - let is_parameter = Lib_info.is_parameter lib.info in - let virtual_ = Lib_info.virtual_ lib.info in - (match lib.implements, virtual_ || is_parameter with - | None, false -> loop acc libs - | Some _, true -> assert false (* can't be virtual and implement *) - | None, true -> loop (Map.set acc lib (No_impl stack)) libs - | Some vlib, false -> + (match lib.implements, Lib_info.kind lib.info with + | None, Dune_file _ -> loop acc libs + | None, (Parameter | Virtual) -> loop (Map.set acc lib (No_impl stack)) libs + | Some _, (Parameter | Virtual) -> + assert false (* can't be virtual and implement *) + | Some vlib, Dune_file _ -> let* vlib = Memo.return vlib in (match Map.find acc vlib with | None -> @@ -948,16 +947,9 @@ end = struct let res = let open Resolve.Memo.O in let* vlib = resolve_forbid_ignore name in - let virtual_ = Lib_info.virtual_ vlib.info in - let is_parameter = Lib_info.is_parameter vlib.info in - match virtual_, is_parameter with - | false, false -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info - | true, false | false, true -> Resolve.Memo.return vlib - | true, true -> - Code_error.raise - "A virtual library can't be a parameter or a parameter can't be a virtual \ - library by construction" - [] + match Lib_info.kind vlib.info with + | Dune_file _ -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info + | Parameter | Virtual -> Resolve.Memo.return vlib in Memo.map res ~f:Option.some in diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 3a11dcef62a..4187fede56e 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -364,10 +364,11 @@ let make_lib_modules | From _ -> assert false in let kind : Modules_field_evaluator.kind = - match lib.virtual_modules, lib.kind with - | None, Parameter -> Parameter - | None, _ -> Exe_or_normal_lib - | Some virtual_modules, _ -> Virtual { virtual_modules } + match lib.kind, lib.virtual_modules with + | Dune_file _, None -> Exe_or_normal_lib + | Parameter, None -> Parameter + | Virtual, Some virtual_modules -> Virtual { virtual_modules } + | _ -> assert false in Memo.return (Resolve.return (kind, main_module_name, wrapped)) | Some _ -> diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index 01a142fb3a2..dd894cd9feb 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -79,14 +79,15 @@ let impl sctx ~(lib : Library.t) ~scope = ] | Some vlib -> let info = Lib.info vlib in - if (not (Lib_info.virtual_ info)) && not (Lib_info.is_parameter info) - then - User_error.raise - ~loc:lib.buildable.loc - [ Pp.textf - "Library %s isn't virtual and cannot be implemented" - (Lib_name.to_string implements) - ]; + (match Lib_info.kind info with + | Parameter | Virtual -> () + | Dune_file _ -> + User_error.raise + ~loc:lib.buildable.loc + [ Pp.textf + "Library %s isn't virtual and cannot be implemented" + (Lib_name.to_string implements) + ]); let+ vlib_modules, vlib_foreign_objects = match Lib_info.modules info, Lib_info.foreign_objects info with | External modules, External fa -> From 6874948fffc1e8b4ccacb67f79c20c51623cc25c Mon Sep 17 00:00:00 2001 From: ArthurW Date: Fri, 5 Sep 2025 15:22:43 +0200 Subject: [PATCH 22/23] fix after review Signed-off-by: ArthurW --- src/dune_rules/compilation_context.ml | 10 ++++++++-- src/dune_rules/compilation_context.mli | 7 ++++++- src/dune_rules/install_rules.ml | 3 ++- src/dune_rules/lib_rules.ml | 7 +++++-- src/dune_rules/ml_sources.ml | 2 +- src/dune_rules/module.ml | 7 ++----- 6 files changed, 24 insertions(+), 12 deletions(-) diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index c49ee3fa265..80dd2d04d92 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -78,6 +78,11 @@ let singleton_modules m = { modules = Modules.With_vlib.singleton m; dep_graphs = Dep_graph.Ml_kind.dummy m } ;; +type implements_parameter = + { main_module : Module_name.t + ; implements_parameter : Module_name.t option Resolve.Memo.t + } + type t = { super_context : Super_context.t ; scope : Scope.t @@ -87,7 +92,7 @@ type t = ; requires_compile : Lib.t list Resolve.Memo.t ; requires_hidden : Lib.t list Resolve.Memo.t ; requires_link : Lib.t list Resolve.t Memo.Lazy.t - ; implements_parameter : (Module_name.t * Module_name.t option Resolve.Memo.t) option + ; implements_parameter : implements_parameter option ; includes : Includes.t ; preprocessing : Pp_spec.t ; opaque : bool @@ -131,7 +136,8 @@ let ocaml t = t.ocaml let implements_parameter t m = match t.implements_parameter with - | Some (root, implements) when Module_name.equal root (Module.name m) -> implements + | Some { main_module; implements_parameter } + when Module_name.equal main_module (Module.name m) -> implements_parameter | _ -> Resolve.Memo.return None ;; diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 15c5be1e147..7a395a87efd 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -18,6 +18,11 @@ type opaque = | Explicit of bool (** Set directly by the caller *) | Inherit_from_settings (** Determined from the version of OCaml and the profile *) +type implements_parameter = + { main_module : Module_name.t + ; implements_parameter : Module_name.t option Resolve.Memo.t + } + (** Create a compilation context. *) val create : super_context:Super_context.t @@ -27,7 +32,7 @@ val create -> flags:Ocaml_flags.t -> requires_compile:Lib.t list Resolve.Memo.t -> requires_link:Lib.t list Resolve.t Memo.Lazy.t - -> ?implements_parameter:Module_name.t * Module_name.t option Resolve.Memo.t + -> ?implements_parameter:implements_parameter -> ?preprocessing:Pp_spec.t -> opaque:opaque -> ?stdlib:Ocaml_stdlib.t diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index ebd1ae50bc9..e749d64d538 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -100,12 +100,13 @@ end = struct match Lib_info.kind lib with | Dune_file _ -> Memo.return (Mode.Map.Multi.to_flat_list @@ Lib_info.foreign_archives lib) - | Parameter | Virtual -> + | Virtual -> let+ foreign_sources = Dir_contents.foreign_sources dir_contents in let name = Lib_info.name lib in let files = Foreign_sources.for_lib foreign_sources ~name in let { Lib_config.ext_obj; _ } = lib_config in Foreign.Sources.object_files files ~dir ~ext_obj + | Parameter -> Memo.return [] in List.rev_append (List.rev_concat_map diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index f707fc64b27..5551ec22041 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -507,8 +507,11 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ let vlib = Vimpl.vlib vimpl in (match Lib_info.kind (Lib.info vlib) with | Parameter -> - let root_module = Module_name.of_local_lib_name lib.name in - Some (root_module, Lib.main_module_name vlib) + let main_module = Module_name.of_local_lib_name lib.name in + Some + { Compilation_context.main_module + ; implements_parameter = Lib.main_module_name vlib + } | _ -> None) in let modules = Vimpl.impl_modules vimpl modules in diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 4187fede56e..389f156a1a2 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -368,7 +368,7 @@ let make_lib_modules | Dune_file _, None -> Exe_or_normal_lib | Parameter, None -> Parameter | Virtual, Some virtual_modules -> Virtual { virtual_modules } - | _ -> assert false + | (Dune_file _ | Parameter), Some _ | Virtual, None -> assert false in Memo.return (Resolve.return (kind, main_module_name, wrapped)) | Some _ -> diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index fc13a52d799..ada39d63387 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -288,7 +288,7 @@ let map_files t ~f = let src_dir t = Source.src_dir t.source let set_pp t pp = { t with pp } -let to_dyn { source; obj_name; pp; visibility; kind; install_as; _ } = +let to_dyn { source; obj_name; pp; visibility; kind; install_as } = Dyn.record [ "source", Source.to_dyn source ; "obj_name", Module_name.Unique.to_dyn obj_name @@ -345,10 +345,7 @@ module Obj_map = struct end) end -let encode - ({ source; obj_name; pp = _; visibility; kind; install_as = _; _ } as t) - ~src_dir - = +let encode ({ source; obj_name; pp = _; visibility; kind; install_as = _ } as t) ~src_dir = let open Dune_lang.Encoder in let has_impl = has t ~ml_kind:Impl in let kind = From c9fa595b9cdbaa4717d6ec5a9c42c9b7fa829cb1 Mon Sep 17 00:00:00 2001 From: ArthurW Date: Mon, 8 Sep 2025 13:05:25 +0200 Subject: [PATCH 23/23] refactor(virtual_rules): distinguish between vimpl and parameters Signed-off-by: ArthurW --- src/dune_rules/compilation_context.ml | 25 +-- src/dune_rules/compilation_context.mli | 11 +- src/dune_rules/dep_rules.ml | 14 +- src/dune_rules/dep_rules.mli | 4 +- src/dune_rules/install_rules.ml | 2 +- src/dune_rules/lib.ml | 19 ++- src/dune_rules/lib_rules.ml | 29 +--- src/dune_rules/menhir/menhir_rules.ml | 4 +- src/dune_rules/module_compilation.ml | 5 +- src/dune_rules/vimpl.ml | 122 ++++++++++++-- src/dune_rules/vimpl.mli | 15 +- src/dune_rules/virtual_rules.ml | 155 ++++++------------ src/dune_rules/virtual_rules.mli | 11 +- .../test-cases/oxcaml/implements-parameter.t | 4 +- 14 files changed, 211 insertions(+), 209 deletions(-) diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index 80dd2d04d92..4d6045141ef 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -78,11 +78,6 @@ let singleton_modules m = { modules = Modules.With_vlib.singleton m; dep_graphs = Dep_graph.Ml_kind.dummy m } ;; -type implements_parameter = - { main_module : Module_name.t - ; implements_parameter : Module_name.t option Resolve.Memo.t - } - type t = { super_context : Super_context.t ; scope : Scope.t @@ -92,7 +87,7 @@ type t = ; requires_compile : Lib.t list Resolve.Memo.t ; requires_hidden : Lib.t list Resolve.Memo.t ; requires_link : Lib.t list Resolve.t Memo.Lazy.t - ; implements_parameter : implements_parameter option + ; implements : Virtual_rules.t ; includes : Includes.t ; preprocessing : Pp_spec.t ; opaque : bool @@ -100,7 +95,6 @@ type t = ; js_of_ocaml : Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t ; sandbox : Sandbox_config.t ; package : Package.t option - ; vimpl : Vimpl.t option ; melange_package_name : Lib_name.t option ; modes : Lib_mode.Map.Set.t ; bin_annot : bool @@ -127,20 +121,13 @@ let sandbox t = t.sandbox let set_sandbox t sandbox = { t with sandbox } let package t = t.package let melange_package_name t = t.melange_package_name -let vimpl t = t.vimpl +let implements t = t.implements let modes t = t.modes let bin_annot t = t.bin_annot let context t = Super_context.context t.super_context let dep_graphs t = t.modules.dep_graphs let ocaml t = t.ocaml -let implements_parameter t m = - match t.implements_parameter with - | Some { main_module; implements_parameter } - when Module_name.equal main_module (Module.name m) -> implements_parameter - | _ -> Resolve.Memo.return None -;; - let create ~super_context ~scope @@ -149,14 +136,13 @@ let create ~flags ~requires_compile ~requires_link - ?implements_parameter ?(preprocessing = Pp_spec.dummy) ~opaque ?stdlib ~js_of_ocaml ~package ~melange_package_name - ?vimpl + ?(implements = Virtual_rules.no_implements) ?modes ?bin_annot ?loc @@ -199,7 +185,7 @@ let create ~sandbox ~obj_dir ~sctx:super_context - ~vimpl + ~impl:implements ~modules and+ bin_annot = match bin_annot with @@ -214,7 +200,7 @@ let create ; requires_compile = direct_requires ; requires_hidden = hidden_requires ; requires_link - ; implements_parameter + ; implements ; includes = Includes.make ~project ~opaque ~direct_requires ~hidden_requires ocaml.lib_config ; preprocessing @@ -223,7 +209,6 @@ let create ; js_of_ocaml ; sandbox ; package - ; vimpl ; melange_package_name ; modes ; bin_annot diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 7a395a87efd..47eafad027c 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -18,11 +18,6 @@ type opaque = | Explicit of bool (** Set directly by the caller *) | Inherit_from_settings (** Determined from the version of OCaml and the profile *) -type implements_parameter = - { main_module : Module_name.t - ; implements_parameter : Module_name.t option Resolve.Memo.t - } - (** Create a compilation context. *) val create : super_context:Super_context.t @@ -32,14 +27,13 @@ val create -> flags:Ocaml_flags.t -> requires_compile:Lib.t list Resolve.Memo.t -> requires_link:Lib.t list Resolve.t Memo.Lazy.t - -> ?implements_parameter:implements_parameter -> ?preprocessing:Pp_spec.t -> opaque:opaque -> ?stdlib:Ocaml_stdlib.t -> js_of_ocaml:Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t -> package:Package.t option -> melange_package_name:Lib_name.t option - -> ?vimpl:Vimpl.t + -> ?implements:Virtual_rules.t -> ?modes:Mode_conf.Set.Details.t Lib_mode.Map.t -> ?bin_annot:bool -> ?loc:Loc.t @@ -63,7 +57,6 @@ val flags : t -> Ocaml_flags.t val requires_link : t -> Lib.t list Resolve.Memo.t val requires_hidden : t -> Lib.t list Resolve.Memo.t val requires_compile : t -> Lib.t list Resolve.Memo.t -val implements_parameter : t -> Module.t -> Module_name.t option Resolve.Memo.t val includes : t -> Command.Args.without_targets Command.Args.t Lib_mode.Cm_kind.Map.t val preprocessing : t -> Pp_spec.t val opaque : t -> bool @@ -72,7 +65,7 @@ val js_of_ocaml : t -> Js_of_ocaml.In_context.t option Js_of_ocaml.Mode.Pair.t val sandbox : t -> Sandbox_config.t val set_sandbox : t -> Sandbox_config.t -> t val package : t -> Package.t option -val vimpl : t -> Vimpl.t option +val implements : t -> Virtual_rules.t val melange_package_name : t -> Lib_name.t option val modes : t -> Lib_mode.Map.Set.t val for_wrapped_compat : t -> t diff --git a/src/dune_rules/dep_rules.ml b/src/dune_rules/dep_rules.ml index 6aa9906f81d..2da4643b15c 100644 --- a/src/dune_rules/dep_rules.ml +++ b/src/dune_rules/dep_rules.ml @@ -131,7 +131,7 @@ let rec deps_of ~obj_dir ~modules ~sandbox - ~vimpl + ~impl ~dir ~sctx ~ml_kind @@ -156,14 +156,14 @@ let rec deps_of in match m with | Imported_from_vlib _ -> - let vimpl = Option.value_exn vimpl in + let vimpl = Virtual_rules.vimpl_exn impl in skip_if_source_absent (deps_of_vlib_module ~obj_dir ~vimpl ~dir ~sctx ~ml_kind) m | Normal m -> skip_if_source_absent (deps_of_module ~modules ~sandbox ~sctx ~dir ~obj_dir ~ml_kind) m | Impl_of_virtual_module impl_or_vlib -> - deps_of ~obj_dir ~modules ~sandbox ~vimpl ~dir ~sctx ~ml_kind + deps_of ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx ~ml_kind @@ let m = Ml_kind.Dict.get impl_or_vlib ml_kind in (match ml_kind with @@ -198,12 +198,12 @@ let dict_of_func_concurrently f = Ml_kind.Dict.make ~impl ~intf ;; -let for_module ~obj_dir ~modules ~sandbox ~vimpl ~dir ~sctx module_ = +let for_module ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx module_ = dict_of_func_concurrently - (deps_of ~obj_dir ~modules ~sandbox ~vimpl ~dir ~sctx (Normal module_)) + (deps_of ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx (Normal module_)) ;; -let rules ~obj_dir ~modules ~sandbox ~vimpl ~sctx ~dir = +let rules ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir = match Modules.With_vlib.as_singleton modules with | Some m -> Memo.return (Dep_graph.Ml_kind.dummy m) | None -> @@ -211,7 +211,7 @@ let rules ~obj_dir ~modules ~sandbox ~vimpl ~sctx ~dir = let+ per_module = Modules.With_vlib.obj_map modules |> Parallel_map.parallel_map ~f:(fun _obj_name m -> - deps_of ~obj_dir ~modules ~sandbox ~vimpl ~sctx ~dir ~ml_kind m) + deps_of ~obj_dir ~modules ~sandbox ~impl ~sctx ~dir ~ml_kind m) in Dep_graph.make ~dir ~per_module) ;; diff --git a/src/dune_rules/dep_rules.mli b/src/dune_rules/dep_rules.mli index 0e14d5a627c..a83040db896 100644 --- a/src/dune_rules/dep_rules.mli +++ b/src/dune_rules/dep_rules.mli @@ -6,7 +6,7 @@ val for_module : obj_dir:Path.Build.t Obj_dir.t -> modules:Modules.With_vlib.t -> sandbox:Sandbox_config.t - -> vimpl:Vimpl.t option + -> impl:Virtual_rules.t -> dir:Path.Build.t -> sctx:Super_context.t -> Module.t @@ -23,7 +23,7 @@ val rules : obj_dir:Path.Build.t Obj_dir.t -> modules:Modules.With_vlib.t -> sandbox:Sandbox_config.t - -> vimpl:Vimpl.t option + -> impl:Virtual_rules.t -> sctx:Super_context.t -> dir:Path.Build.t -> Dep_graph.Ml_kind.t Memo.t diff --git a/src/dune_rules/install_rules.ml b/src/dune_rules/install_rules.ml index e749d64d538..c1a6e85b7f8 100644 --- a/src/dune_rules/install_rules.ml +++ b/src/dune_rules/install_rules.ml @@ -211,7 +211,7 @@ end = struct ~libs:(Scope.libs scope) ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) and+ impl = Virtual_rules.impl sctx ~lib ~scope in - Vimpl.impl_modules impl modules |> Modules.With_vlib.split_by_lib + Virtual_rules.impl_modules impl modules |> Modules.With_vlib.split_by_lib in let lib_src_dir = Lib_info.src_dir info in let sources = diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index e87305dcc37..085b17e8131 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -235,16 +235,16 @@ module Error = struct ] ;; - let not_virtual_lib ~loc ~impl ~not_vlib = - let impl = Lib_info.name impl in - let not_vlib = Lib_info.name not_vlib in + let not_implementable ~loc ~lib ~not_impl = + let lib = Lib_info.name lib in + let not_impl = Lib_info.name not_impl in make ~loc [ Pp.textf "Library %S is neither a virtual library nor a library parameter. It cannot be \ implemented by %S." - (Lib_name.to_string not_vlib) - (Lib_name.to_string impl) + (Lib_name.to_string not_impl) + (Lib_name.to_string lib) ] ;; end @@ -946,10 +946,11 @@ end = struct | Some ((loc, _) as name) -> let res = let open Resolve.Memo.O in - let* vlib = resolve_forbid_ignore name in - match Lib_info.kind vlib.info with - | Dune_file _ -> Error.not_virtual_lib ~loc ~impl:info ~not_vlib:vlib.info - | Parameter | Virtual -> Resolve.Memo.return vlib + let* implements = resolve_forbid_ignore name in + match Lib_info.kind implements.info with + | Dune_file _ -> + Error.not_implementable ~loc ~lib:info ~not_impl:implements.info + | Parameter | Virtual -> Resolve.Memo.return implements in Memo.map res ~f:Option.some in diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 5551ec22041..4c501c6d9b2 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -489,7 +489,7 @@ let setup_build_archives (lib : Library.t) ~top_sorted_modules ~cctx ~expander ~ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_info = let* flags = Buildable_rules.ocaml_flags sctx ~dir lib.buildable.flags - and* vimpl = Virtual_rules.impl sctx ~lib ~scope in + and* implements = Virtual_rules.impl sctx ~lib ~scope in let obj_dir = Library.obj_dir ~dir lib in let* modules, pp = Buildable_rules.modules_rules @@ -500,21 +500,7 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ scope source_modules in - let implements_parameter = - match vimpl with - | None -> None - | Some vimpl -> - let vlib = Vimpl.vlib vimpl in - (match Lib_info.kind (Lib.info vlib) with - | Parameter -> - let main_module = Module_name.of_local_lib_name lib.name in - Some - { Compilation_context.main_module - ; implements_parameter = Lib.main_module_name vlib - } - | _ -> None) - in - let modules = Vimpl.impl_modules vimpl modules in + let modules = Virtual_rules.impl_modules implements modules in let requires_compile = Lib.Compile.direct_requires compile_info in let requires_link = Lib.Compile.requires_link compile_info in let* modes = @@ -547,13 +533,12 @@ let cctx (lib : Library.t) ~sctx ~source_modules ~dir ~expander ~scope ~compile_ ~flags ~requires_compile ~requires_link - ?implements_parameter + ~implements ~preprocessing:pp ~opaque:Inherit_from_settings ~js_of_ocaml:(Js_of_ocaml.Mode.Pair.map ~f:Option.some js_of_ocaml) ?stdlib:lib.stdlib ~package - ?vimpl ~melange_package_name ~modes ;; @@ -569,7 +554,7 @@ let library_rules = let modules = Compilation_context.modules cctx in let obj_dir = Compilation_context.obj_dir cctx in - let vimpl = Compilation_context.vimpl cctx in + let implements = Compilation_context.implements cctx in let sctx = Compilation_context.super_context cctx in let dir = Compilation_context.dir cctx in let scope = Compilation_context.scope cctx in @@ -581,9 +566,7 @@ let library_rules (Compilation_context.dep_graphs cctx).impl impl_only in - let* () = - Memo.Option.iter vimpl ~f:(Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir) - in + let* () = Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir implements in let* expander = Super_context.expander sctx ~dir in let* () = Check_rules.add_cycle_check sctx ~dir top_sorted_modules in let* () = gen_wrapped_compat_modules lib cctx @@ -608,7 +591,7 @@ let library_rules (not (Library.is_virtual lib)) (fun () -> setup_build_archives lib ~lib_info ~top_sorted_modules ~cctx ~expander) and+ () = - let vlib_stubs_o_files = Vimpl.vlib_stubs_o_files vimpl in + let vlib_stubs_o_files = Virtual_rules.stubs_o_files implements in Memo.when_ (Library.has_foreign lib || List.is_non_empty vlib_stubs_o_files) (fun () -> diff --git a/src/dune_rules/menhir/menhir_rules.ml b/src/dune_rules/menhir/menhir_rules.ml index 5a9eaf34d43..ebb0472510a 100644 --- a/src/dune_rules/menhir/menhir_rules.ml +++ b/src/dune_rules/menhir/menhir_rules.ml @@ -276,9 +276,9 @@ module Run (P : PARAMS) = struct let* deps = let obj_dir = Compilation_context.obj_dir cctx in let modules = Compilation_context.modules cctx in - let vimpl = Compilation_context.vimpl cctx in + let impl = Compilation_context.implements cctx in let dir = Obj_dir.dir obj_dir in - Dep_rules.for_module ~obj_dir ~modules ~sandbox ~vimpl ~dir ~sctx mock_module + Dep_rules.for_module ~obj_dir ~modules ~sandbox ~impl ~dir ~sctx mock_module in let* () = Module_compilation.ocamlc_i ~deps cctx mock_module ~output:(inferred_mli base) diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 7c2e7c63611..8683ec407c2 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -241,9 +241,8 @@ let build_cm let as_argument_for = Command.Args.dyn (let open Action_builder.O in - let+ argument = - Resolve.Memo.read @@ Compilation_context.implements_parameter cctx m - in + let impl = Compilation_context.implements cctx in + let+ argument = Resolve.Memo.read @@ Virtual_rules.implements_parameter impl m in match argument with | None -> [] | Some parameter -> [ "-as-argument-for"; Module_name.to_string parameter ]) diff --git a/src/dune_rules/vimpl.ml b/src/dune_rules/vimpl.ml index 85d8360419f..2a95ae7cb8d 100644 --- a/src/dune_rules/vimpl.ml +++ b/src/dune_rules/vimpl.ml @@ -12,14 +12,55 @@ let vlib_modules t = t.vlib_modules let vlib t = t.vlib let impl t = t.impl let impl_cm_kind t = t.impl_cm_kind +let vlib_stubs_o_files t = t.vlib_foreign_objects +let vlib_obj_map t = Modules.obj_map t.vlib_modules -let impl_modules t m = - match t with - | None -> Modules.With_vlib.modules m - | Some t -> Modules.With_vlib.impl ~vlib:t.vlib_modules m -;; - -let make ~vlib ~impl ~vlib_modules ~vlib_foreign_objects = +let make ~sctx ~scope ~(lib : Library.t) ~info ~vlib = + let open Memo.O in + let+ vlib_modules, vlib_foreign_objects = + match Lib_info.modules info, Lib_info.foreign_objects info with + | External modules, External fa -> + let modules = Option.value_exn modules in + Memo.return (Modules.With_vlib.drop_vlib modules, fa) + | External _, Local | Local, External _ -> assert false + | Local, Local -> + let name = Lib.name vlib in + let vlib = Lib.Local.of_lib_exn vlib in + let* dir_contents = + let info = Lib.Local.info vlib in + let dir = Lib_info.src_dir info in + Dir_contents.get sctx ~dir + in + let* ocaml = Context.ocaml (Super_context.context sctx) in + let* modules = + let db = Scope.libs scope in + let* preprocess = + (* TODO wrong, this should be delayed *) + Instrumentation.with_instrumentation + lib.buildable.preprocess + ~instrumentation_backend:(Lib.DB.instrumentation_backend db) + |> Resolve.Memo.read_memo + in + Dir_contents.ocaml dir_contents + >>= Ml_sources.modules + ~libs:db + ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) + >>= + let pp_spec = + Staged.unstage (Pp_spec.pped_modules_map preprocess ocaml.version) + in + Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) + in + let+ foreign_objects = + Dir_contents.foreign_sources dir_contents + >>| Foreign_sources.for_lib ~name + >>| (let ext_obj = ocaml.lib_config.ext_obj in + let dir = Obj_dir.obj_dir (Lib.Local.obj_dir vlib) in + Foreign.Sources.object_files ~ext_obj ~dir) + >>| List.map ~f:Path.build + in + modules, foreign_objects + in let impl_cm_kind = let vlib_info = Lib.info vlib in let { Lib_mode.Map.ocaml = { byte; native = _ }; melange = _ } = @@ -27,12 +68,67 @@ let make ~vlib ~impl ~vlib_modules ~vlib_foreign_objects = in Mode.cm_kind (if byte then Byte else Native) in - { impl; impl_cm_kind; vlib; vlib_modules; vlib_foreign_objects } + { impl = lib; impl_cm_kind; vlib; vlib_modules; vlib_foreign_objects } ;; -let vlib_stubs_o_files = function - | None -> [] - | Some t -> t.vlib_foreign_objects +let setup_copy_rules ~sctx ~dir vimpl = + let open Memo.O in + let ctx = Super_context.context sctx in + let impl_obj_dir = Library.obj_dir ~dir vimpl.impl in + let vlib_obj_dir = Lib.info vimpl.vlib |> Lib_info.obj_dir in + let add_rule = Super_context.add_rule sctx ~dir in + let copy_to_obj_dir ~src ~dst = + add_rule ~loc:(Loc.of_pos __POS__) (Action_builder.symlink ~src ~dst) + in + let* { Lib_config.has_native; ext_obj; _ } = + let+ ocaml = Context.ocaml ctx in + ocaml.lib_config + in + let { Lib_mode.Map.ocaml = { byte; native }; melange } = + Mode_conf.Lib.Set.eval vimpl.impl.modes ~has_native + in + let copy_obj_file m kind = + let src = Obj_dir.Module.cm_file_exn vlib_obj_dir m ~kind in + let dst = Obj_dir.Module.cm_file_exn impl_obj_dir m ~kind in + copy_to_obj_dir ~src ~dst + in + let copy_ocamldep_file m = + match Obj_dir.to_local vlib_obj_dir with + | None -> Memo.return () + | Some vlib_obj_dir -> + (match Obj_dir.Module.dep vlib_obj_dir (Immediate (m, Impl)) with + | None -> Memo.return () + | Some src -> + let src = Path.build src in + let dst = + Obj_dir.Module.dep impl_obj_dir (Immediate (m, Impl)) |> Option.value_exn + in + copy_to_obj_dir ~src ~dst) + in + let copy_interface_to_impl ~src kind () = + let dst = Obj_dir.Module.cm_public_file_exn impl_obj_dir src ~kind in + let src = Obj_dir.Module.cm_public_file_exn vlib_obj_dir src ~kind in + copy_to_obj_dir ~src ~dst + in + let copy_objs src = + Memo.when_ (byte || native) (fun () -> copy_obj_file src (Ocaml Cmi)) + >>> Memo.when_ melange (fun () -> copy_obj_file src (Melange Cmi)) + >>> Memo.when_ + (Module.visibility src = Public + && Obj_dir.need_dedicated_public_dir impl_obj_dir) + (fun () -> + Memo.when_ (byte || native) (copy_interface_to_impl ~src (Ocaml Cmi)) + >>> Memo.when_ melange (copy_interface_to_impl ~src (Melange Cmi))) + >>> Memo.when_ (Module.has src ~ml_kind:Impl) (fun () -> + Memo.when_ byte (fun () -> copy_obj_file src (Ocaml Cmo)) + >>> Memo.when_ melange (fun () -> + copy_obj_file src (Melange Cmj) >>> copy_ocamldep_file src) + >>> Memo.when_ native (fun () -> + copy_obj_file src (Ocaml Cmx) + >>> + let object_file dir = Obj_dir.Module.o_file_exn dir src ~ext_obj in + copy_to_obj_dir ~src:(object_file vlib_obj_dir) ~dst:(object_file impl_obj_dir))) + in + let vlib_modules = vlib_modules vimpl in + Modules.fold vlib_modules ~init:(Memo.return ()) ~f:(fun m acc -> acc >>> copy_objs m) ;; - -let vlib_obj_map t = Modules.obj_map t.vlib_modules diff --git a/src/dune_rules/vimpl.mli b/src/dune_rules/vimpl.mli index c756b4cd9e2..77ddfcfb948 100644 --- a/src/dune_rules/vimpl.mli +++ b/src/dune_rules/vimpl.mli @@ -6,11 +6,12 @@ open Import type t val make - : vlib:Lib.t - -> impl:Library.t - -> vlib_modules:Modules.t - -> vlib_foreign_objects:Path.t list - -> t + : sctx:Super_context.t + -> scope:Scope.t + -> lib:Library.t + -> info:Path.t Lib_info.t + -> vlib:Lib.t + -> t Memo.t val impl : t -> Library.t @@ -18,12 +19,12 @@ val impl : t -> Library.t setting up the copying rules *) val vlib_modules : t -> Modules.t -val impl_modules : t option -> Modules.t -> Modules.With_vlib.t val vlib : t -> Lib.t (** Return the combined list of .o files for stubs consisting of .o files from the implementation and virtual library.*) -val vlib_stubs_o_files : t option -> Path.t list +val vlib_stubs_o_files : t -> Path.t list val impl_cm_kind : t -> Cm_kind.t val vlib_obj_map : t -> Modules.Sourced_module.t Module_name.Unique.Map.t +val setup_copy_rules : sctx:Super_context.t -> dir:Path.Build.t -> t -> unit Memo.t diff --git a/src/dune_rules/virtual_rules.ml b/src/dune_rules/virtual_rules.ml index dd894cd9feb..3f00caef4b1 100644 --- a/src/dune_rules/virtual_rules.ml +++ b/src/dune_rules/virtual_rules.ml @@ -1,72 +1,48 @@ open Import open Memo.O -let setup_copy_rules_for_impl ~sctx ~dir vimpl = - let ctx = Super_context.context sctx in - let vlib = Vimpl.vlib vimpl in - let impl = Vimpl.impl vimpl in - let impl_obj_dir = Library.obj_dir ~dir impl in - let vlib_obj_dir = Lib.info vlib |> Lib_info.obj_dir in - let add_rule = Super_context.add_rule sctx ~dir in - let copy_to_obj_dir ~src ~dst = - add_rule ~loc:(Loc.of_pos __POS__) (Action_builder.symlink ~src ~dst) - in - let* { Lib_config.has_native; ext_obj; _ } = - let+ ocaml = Context.ocaml ctx in - ocaml.lib_config - in - let { Lib_mode.Map.ocaml = { byte; native }; melange } = - Mode_conf.Lib.Set.eval impl.modes ~has_native - in - let copy_obj_file m kind = - let src = Obj_dir.Module.cm_file_exn vlib_obj_dir m ~kind in - let dst = Obj_dir.Module.cm_file_exn impl_obj_dir m ~kind in - copy_to_obj_dir ~src ~dst - in - let copy_ocamldep_file m = - match Obj_dir.to_local vlib_obj_dir with - | None -> Memo.return () - | Some vlib_obj_dir -> - (match Obj_dir.Module.dep vlib_obj_dir (Immediate (m, Impl)) with - | None -> Memo.return () - | Some src -> - let src = Path.build src in - let dst = - Obj_dir.Module.dep impl_obj_dir (Immediate (m, Impl)) |> Option.value_exn - in - copy_to_obj_dir ~src ~dst) - in - let copy_interface_to_impl ~src kind () = - let dst = Obj_dir.Module.cm_public_file_exn impl_obj_dir src ~kind in - let src = Obj_dir.Module.cm_public_file_exn vlib_obj_dir src ~kind in - copy_to_obj_dir ~src ~dst - in - let copy_objs src = - Memo.when_ (byte || native) (fun () -> copy_obj_file src (Ocaml Cmi)) - >>> Memo.when_ melange (fun () -> copy_obj_file src (Melange Cmi)) - >>> Memo.when_ - (Module.visibility src = Public - && Obj_dir.need_dedicated_public_dir impl_obj_dir) - (fun () -> - Memo.when_ (byte || native) (copy_interface_to_impl ~src (Ocaml Cmi)) - >>> Memo.when_ melange (copy_interface_to_impl ~src (Melange Cmi))) - >>> Memo.when_ (Module.has src ~ml_kind:Impl) (fun () -> - Memo.when_ byte (fun () -> copy_obj_file src (Ocaml Cmo)) - >>> Memo.when_ melange (fun () -> - copy_obj_file src (Melange Cmj) >>> copy_ocamldep_file src) - >>> Memo.when_ native (fun () -> - copy_obj_file src (Ocaml Cmx) - >>> - let object_file dir = Obj_dir.Module.o_file_exn dir src ~ext_obj in - copy_to_obj_dir ~src:(object_file vlib_obj_dir) ~dst:(object_file impl_obj_dir))) - in - let vlib_modules = Vimpl.vlib_modules vimpl in - Modules.fold vlib_modules ~init:(Memo.return ()) ~f:(fun m acc -> acc >>> copy_objs m) +type t = + | No_implements + | Virtual of Vimpl.t + | Parameter of + { main_module : Module_name.t + ; implements_parameter : Module_name.t option Resolve.Memo.t + } + +let no_implements = No_implements + +let setup_copy_rules_for_impl ~sctx ~dir t = + match t with + | No_implements | Parameter _ -> Memo.return () + | Virtual vimpl -> Vimpl.setup_copy_rules ~sctx ~dir vimpl +;; + +let stubs_o_files = function + | No_implements | Parameter _ -> [] + | Virtual vimpl -> Vimpl.vlib_stubs_o_files vimpl +;; + +let implements_parameter t m = + match t with + | Parameter { main_module; implements_parameter } + when Module_name.equal main_module (Module.name m) -> implements_parameter + | _ -> Resolve.Memo.return None +;; + +let impl_modules t m = + match t with + | No_implements | Parameter _ -> Modules.With_vlib.modules m + | Virtual vimpl -> Modules.With_vlib.impl ~vlib:(Vimpl.vlib_modules vimpl) m +;; + +let vimpl_exn = function + | Virtual vimpl -> vimpl + | No_implements | Parameter _ -> Code_error.raise "Virtual_rules.vimpl_exn" [] ;; let impl sctx ~(lib : Library.t) ~scope = match lib.implements with - | None -> Memo.return None + | None -> Memo.return No_implements | Some (loc, implements) -> Lib.DB.find (Scope.libs scope) implements >>= (function @@ -80,57 +56,18 @@ let impl sctx ~(lib : Library.t) ~scope = | Some vlib -> let info = Lib.info vlib in (match Lib_info.kind info with - | Parameter | Virtual -> () | Dune_file _ -> User_error.raise ~loc:lib.buildable.loc [ Pp.textf "Library %s isn't virtual and cannot be implemented" (Lib_name.to_string implements) - ]); - let+ vlib_modules, vlib_foreign_objects = - match Lib_info.modules info, Lib_info.foreign_objects info with - | External modules, External fa -> - let modules = Option.value_exn modules in - Memo.return (Modules.With_vlib.drop_vlib modules, fa) - | External _, Local | Local, External _ -> assert false - | Local, Local -> - let name = Lib.name vlib in - let vlib = Lib.Local.of_lib_exn vlib in - let* dir_contents = - let info = Lib.Local.info vlib in - let dir = Lib_info.src_dir info in - Dir_contents.get sctx ~dir - in - let* ocaml = Context.ocaml (Super_context.context sctx) in - let* modules = - let db = Scope.libs scope in - let* preprocess = - (* TODO wrong, this should be delayed *) - Instrumentation.with_instrumentation - lib.buildable.preprocess - ~instrumentation_backend:(Lib.DB.instrumentation_backend db) - |> Resolve.Memo.read_memo - in - Dir_contents.ocaml dir_contents - >>= Ml_sources.modules - ~libs:db - ~for_:(Library (Lib_info.lib_id info |> Lib_id.to_local_exn)) - >>= - let pp_spec = - Staged.unstage (Pp_spec.pped_modules_map preprocess ocaml.version) - in - Modules.map_user_written ~f:(fun m -> Memo.return (pp_spec m)) - in - let+ foreign_objects = - Dir_contents.foreign_sources dir_contents - >>| Foreign_sources.for_lib ~name - >>| (let ext_obj = ocaml.lib_config.ext_obj in - let dir = Obj_dir.obj_dir (Lib.Local.obj_dir vlib) in - Foreign.Sources.object_files ~ext_obj ~dir) - >>| List.map ~f:Path.build - in - modules, foreign_objects - in - Some (Vimpl.make ~impl:lib ~vlib ~vlib_modules ~vlib_foreign_objects)) + ] + | Parameter -> + let main_module = Module_name.of_local_lib_name lib.name in + Memo.return + (Parameter { main_module; implements_parameter = Lib.main_module_name vlib }) + | Virtual -> + let+ vimpl = Vimpl.make ~sctx ~scope ~lib ~info ~vlib in + Virtual vimpl)) ;; diff --git a/src/dune_rules/virtual_rules.mli b/src/dune_rules/virtual_rules.mli index 64adc0e8aa4..f262415ed95 100644 --- a/src/dune_rules/virtual_rules.mli +++ b/src/dune_rules/virtual_rules.mli @@ -1,9 +1,16 @@ open Import +type t + val setup_copy_rules_for_impl : sctx:Super_context.t -> dir:Path.Build.t - -> Vimpl.t + -> t -> unit Memo.t -val impl : Super_context.t -> lib:Library.t -> scope:Scope.t -> Vimpl.t option Memo.t +val no_implements : t +val impl : Super_context.t -> lib:Library.t -> scope:Scope.t -> t Memo.t +val impl_modules : t -> Modules.t -> Modules.With_vlib.t +val stubs_o_files : t -> Path.t list +val implements_parameter : t -> Module.t -> Module_name.t option Resolve.Memo.t +val vimpl_exn : t -> Vimpl.t diff --git a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t index 2e05d134122..318100736f0 100644 --- a/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t +++ b/test/blackbox-tests/test-cases/oxcaml/implements-parameter.t @@ -110,8 +110,8 @@ interface: $ dune build File "foo_impl/foo_impl.ml", line 1: Error: The argument module foo_impl/foo_impl.ml - does not match the parameter signature foo_impl/.foo_impl.objs/byte/foo.cmi: - The value f is required but not provided + does not match the parameter signature foo/.foo.objs/byte/foo.cmi: + The value f is required but not provided File "foo/foo.mli", line 2, characters 0-17: Expected declaration [1]