diff --git a/src/dune_rules/compilation_context.ml b/src/dune_rules/compilation_context.ml index c53570028aba..161d10eb5ab9 100644 --- a/src/dune_rules/compilation_context.ml +++ b/src/dune_rules/compilation_context.ml @@ -3,6 +3,8 @@ open! Stdune open Import module SC = Super_context +let modules_of_lib = Fdecl.create Dyn.Encoder.opaque + module Includes = struct type t = Command.Args.dynamic Command.Args.t Cm_kind.Dict.t @@ -70,7 +72,6 @@ type t = ; vimpl : Vimpl.t option ; modes : Mode.Dict.Set.t ; bin_annot : bool - ; modules_of_lib : Lib.t -> Modules.t Or_exn.t } let super_context t = t.super_context @@ -115,31 +116,10 @@ let bin_annot t = t.bin_annot let context t = Super_context.context t.super_context -type rename = - { new_name : Module_name.t - ; old_name : Module_name.t - } - -let renames t = - let open Result.O in - let* renames = t.renames in - Result.List.map renames ~f:(fun (lib, new_name) -> - let* main_module_name = Lib.main_module_name lib in - let+ old_name = - match main_module_name with - | Some m -> Ok m - | None -> - Error - (User_error.E - (User_error.make - [ Pp.text "renaming unwrapped not supported yet" ])) - in - { new_name; old_name }) - let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags ~requires_compile ~requires_link ?(preprocessing = Pp_spec.dummy) ~opaque - ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes ?(bin_annot = true) - ?(renames = Ok []) () = + ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes ?(bin_annot = true) () + = let project = Scope.project scope in let requires_compile = if Dune_project.implicit_transitive_deps project then @@ -180,15 +160,14 @@ let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags ; vimpl ; modes ; bin_annot - ; renames } let for_alias_module t = let flags = let project = Scope.project t.scope in let dune_version = Dune_project.dune_version project in - Ocaml_flags.default ~profile:(Super_context.context t.super_context).profile - ~dune_version + let profile = (Super_context.context t.super_context).profile in + Ocaml_flags.default ~dune_version ~profile in let sandbox = let ctx = Super_context.context t.super_context in @@ -213,8 +192,8 @@ let for_root_module t = let flags = let project = Scope.project t.scope in let dune_version = Dune_project.dune_version project in - Ocaml_flags.default ~profile:(Super_context.context t.super_context).profile - ~dune_version + let profile = (Super_context.context t.super_context).profile in + Ocaml_flags.default ~profile ~dune_version in { t with flags = @@ -252,9 +231,8 @@ let for_plugin_executable t ~embed_in_plugin_libraries = let without_bin_annot t = { t with bin_annot = false } -let root_module_entries t = - Some ( - let+ requires = t.requires_compile in - List.map requires ~f:(fun require -> - ) - ) +let root_module_entries t : Module_name.t list Or_exn.t = + let open Result.O in + let* requires = t.requires_compile in + let local_lib = Fdecl.get modules_of_lib t.super_context in + Result.List.concat_map requires ~f:(Lib.entry_module_names ~local_lib) diff --git a/src/dune_rules/compilation_context.mli b/src/dune_rules/compilation_context.mli index 4f1344cdc372..6128d6ce03be 100644 --- a/src/dune_rules/compilation_context.mli +++ b/src/dune_rules/compilation_context.mli @@ -21,6 +21,10 @@ type opaque = | Inherit_from_settings (** Determined from the version of OCaml and the profile *) +val modules_of_lib : + (* to avoid a cycle with [Dir_contents] *) + (Super_context.t -> dir:Path.Build.t -> name:Lib_name.t -> Modules.t) Fdecl.t + (** Create a compilation context. *) val create : super_context:Super_context.t @@ -102,5 +106,4 @@ val bin_annot : t -> bool val without_bin_annot : t -> t -val root_module_entries : - t -> (Module_name.t * Module_name.t list) list Or_exn.t option +val root_module_entries : t -> Module_name.t list Or_exn.t diff --git a/src/dune_rules/dir_contents.ml b/src/dune_rules/dir_contents.ml index e5ba636b9242..ad44fc2748ea 100644 --- a/src/dune_rules/dir_contents.ml +++ b/src/dune_rules/dir_contents.ml @@ -336,6 +336,14 @@ end = struct | See_above _ -> assert false | Here { t; rules = _; subdirs = _ } -> t ) + let () = + let f sctx ~dir ~name = + let t = get sctx ~dir in + let ml_sources = ocaml t in + Ml_sources.modules_of_library ml_sources ~name + in + Fdecl.set Compilation_context.modules_of_lib f + let gen_rules sctx ~dir = match Memo.exec memo0 (sctx, dir) with | See_above group_root -> Group_part group_root diff --git a/src/dune_rules/dune_file.ml b/src/dune_rules/dune_file.ml index 41e0ac9dbda2..b81fa8734638 100644 --- a/src/dune_rules/dune_file.ml +++ b/src/dune_rules/dune_file.ml @@ -264,7 +264,10 @@ module Buildable = struct repeat (String_with_vars.decode >>| version_check) in (libname, flags))) )) - and+ root_module = field_o "root_module" Module_name.decode_loc in + and+ root_module = + field_o "root_module" + (Dune_lang.Syntax.since Stanza.syntax (2, 8) >>> Module_name.decode_loc) + in let preprocess = let init = let f libname = Preprocess.With_instrumentation.Ordinary libname in @@ -913,13 +916,14 @@ module Library = struct let wrapped = Some conf.wrapped in let special_builtin_support = conf.special_builtin_support in let instrumentation_backend = conf.instrumentation_backend in + let entry_modules = Lib_info.Source.Local in Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive - ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~implements - ~default_implementation ~modes ~wrapped ~special_builtin_support - ~exit_module ~instrumentation_backend + ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~entry_modules + ~implements ~default_implementation ~modes ~wrapped + ~special_builtin_support ~exit_module ~instrumentation_backend end module Plugin = struct diff --git a/src/dune_rules/dune_package.ml b/src/dune_rules/dune_package.ml index 2175008045df..7b57df7eb8fa 100644 --- a/src/dune_rules/dune_package.ml +++ b/src/dune_rules/dune_package.ml @@ -141,7 +141,7 @@ module Lib = struct and+ orig_src_dir = field_o "orig_src_dir" path and+ modules = let src_dir = Obj_dir.dir obj_dir in - field_o "modules" + field "modules" (Modules.decode ~implements:(Option.is_some implements) ~src_dir ~version:lang.version) @@ -153,6 +153,9 @@ module Lib = struct field_o "instrumentation.backend" (located Lib_name.decode) in let modes = Mode.Dict.Set.of_list modes in + let entry_modules = + Modules.entry_modules modules |> List.map ~f:Module.name + in let info : Path.t Lib_info.t = let src_dir = Obj_dir.dir obj_dir in let enabled = Lib_info.Enabled_status.Normal in @@ -170,25 +173,24 @@ module Lib = struct let dune_version = None in let virtual_ = if virtual_ then - let modules = Option.value_exn modules in Some (Lib_info.Source.External modules) else None in let wrapped = - Option.map modules ~f:Modules.wrapped - |> Option.map ~f:(fun w -> Lib_info.Inherited.This w) + Some (Lib_info.Inherited.This (Modules.wrapped modules)) in + let entry_modules = Lib_info.Source.External (Ok entry_modules) in Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files:[] ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled ~virtual_deps - ~dune_version ~virtual_ ~implements ~default_implementation ~modes - ~wrapped ~special_builtin_support ~exit_module:None - ~instrumentation_backend + ~dune_version ~virtual_ ~entry_modules ~implements + ~default_implementation ~modes ~wrapped ~special_builtin_support + ~exit_module:None ~instrumentation_backend in - { info; main_module_name; modules }) + { info; main_module_name; modules = Some modules }) let modules t = t.modules diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml index c4ae3ca6a3da..07da74082949 100644 --- a/src/dune_rules/findlib/findlib.ml +++ b/src/dune_rules/findlib/findlib.ml @@ -330,13 +330,14 @@ end = struct let virtual_ = None in let default_implementation = None in let wrapped = None in + let dir_contents = Path.readdir_unsorted t.dir in let foreign_archives, native_archives = (* Here we scan [t.dir] and consider all files named [lib*.ext_lib] to be foreign archives, and all other files with the extension [ext_lib] to be native archives. The resulting lists of archives will be used to compute appropriate flags for linking dependent executables. *) - match Path.readdir_unsorted t.dir with + match dir_contents with | Error _ -> (* Raising an error is not an option here as we systematically delay all library loading errors until the libraries are actually used @@ -368,6 +369,31 @@ end = struct let sort = List.sort ~compare:Path.compare in (sort foreign_archives, sort native_archives) in + let entry_modules = + Lib_info.Source.External + ( match dir_contents with + | Error e -> + Error + (User_error.E + (User_message.make + [ Pp.textf "Unable to get entry modules of %s in %s. " + (Lib_name.to_string t.name) + (Path.to_string src_dir) + ; Pp.textf "error: %s" (Unix.error_message e) + ])) + | Ok files -> + let ext = Cm_kind.ext Cmi in + Result.List.filter_map files ~f:(fun fname -> + match Filename.check_suffix fname ext with + | false -> Ok None + | true -> ( + match + let name = Filename.chop_extension fname in + Module_name.of_string_user_error (Loc.in_dir src_dir, name) + with + | Ok s -> Ok (Some s) + | Error e -> Error (User_error.E e) )) ) + in Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps @@ -375,7 +401,7 @@ end = struct ~jsoo_archive ~preprocess ~enabled ~virtual_deps ~dune_version ~virtual_ ~implements ~default_implementation ~modes ~wrapped ~special_builtin_support ~exit_module:None - ~instrumentation_backend:None + ~instrumentation_backend:None ~entry_modules in Dune_package.Lib.make ~info ~modules:None ~main_module_name:None end diff --git a/src/dune_rules/lib.ml b/src/dune_rules/lib.ml index 31ca2fe8d547..5cb6bef3182e 100644 --- a/src/dune_rules/lib.ml +++ b/src/dune_rules/lib.ml @@ -366,6 +366,14 @@ let main_module_name t = | This x -> x | From _ -> assert false ) +let entry_module_names t ~local_lib = + match Lib_info.entry_modules t.info with + | External d -> d + | Local -> + let info = Lib_info.as_local_exn t.info in + let modules = local_lib ~dir:(Lib_info.src_dir info) ~name:t.name in + Ok (Modules.entry_modules modules |> List.map ~f:Module.name) + let wrapped t = let wrapped = Lib_info.wrapped t.info in match wrapped with diff --git a/src/dune_rules/lib.mli b/src/dune_rules/lib.mli index c27474aaacd3..4e1a112f7aca 100644 --- a/src/dune_rules/lib.mli +++ b/src/dune_rules/lib.mli @@ -27,6 +27,11 @@ val info : t -> Path.t Lib_info.t val main_module_name : t -> Module_name.t option Or_exn.t +val entry_module_names : + t + -> local_lib:(dir:Path.Build.t -> name:Lib_name.t -> Modules.t) + -> Module_name.t list Or_exn.t + val wrapped : t -> Wrapped.t option Or_exn.t (** [is_impl lib] returns [true] if the library is an implementation of a diff --git a/src/dune_rules/lib_info.ml b/src/dune_rules/lib_info.ml index a15a0f5965ac..a244aaa6a3da 100644 --- a/src/dune_rules/lib_info.ml +++ b/src/dune_rules/lib_info.ml @@ -274,6 +274,7 @@ type 'path t = ; dune_version : Dune_lang.Syntax.Version.t option ; sub_systems : Sub_system_info.t Sub_system_name.Map.t ; virtual_ : Modules.t Source.t option + ; entry_modules : Module_name.t list Or_exn.t Source.t ; implements : (Loc.t * Lib_name.t) option ; default_implementation : (Loc.t * Lib_name.t) option ; wrapped : Wrapped.t Inherited.t option @@ -389,9 +390,9 @@ let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives ~native_archives ~foreign_dll_files ~jsoo_runtime ~jsoo_archive ~preprocess ~enabled - ~virtual_deps ~dune_version ~virtual_ ~implements ~default_implementation - ~modes ~wrapped ~special_builtin_support ~exit_module - ~instrumentation_backend = + ~virtual_deps ~dune_version ~virtual_ ~entry_modules ~implements + ~default_implementation ~modes ~wrapped ~special_builtin_support + ~exit_module ~instrumentation_backend = { loc ; name ; kind @@ -418,6 +419,7 @@ let create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir ~version ; dune_version ; sub_systems ; virtual_ + ; entry_modules ; implements ; default_implementation ; modes @@ -490,6 +492,7 @@ let to_dyn path ; special_builtin_support ; exit_module ; instrumentation_backend + ; entry_modules } = let open Dyn.Encoder in let snd f (_, x) = f x in @@ -518,6 +521,8 @@ let to_dyn path ; ("dune_version", option Dune_lang.Syntax.Version.to_dyn dune_version) ; ("sub_systems", Sub_system_name.Map.to_dyn Dyn.Encoder.opaque sub_systems) ; ("virtual_", option (Source.to_dyn Modules.to_dyn) virtual_) + ; ( "entry_modules" + , Source.to_dyn (Or_exn.to_dyn (list Module_name.to_dyn)) entry_modules ) ; ("implements", option (snd Lib_name.to_dyn) implements) ; ( "default_implementation" , option (snd Lib_name.to_dyn) default_implementation ) @@ -543,3 +548,5 @@ let has_native_archive lib_config modules = Lib_config.linker_can_create_empty_archives lib_config && Ocaml_version.ocamlopt_always_calls_library_linker lib_config.ocaml_version || not (Modules.is_empty modules) + +let entry_modules t = t.entry_modules diff --git a/src/dune_rules/lib_info.mli b/src/dune_rules/lib_info.mli index 0460dc859f8b..defdadb28ed9 100644 --- a/src/dune_rules/lib_info.mli +++ b/src/dune_rules/lib_info.mli @@ -131,6 +131,8 @@ val obj_dir : 'path t -> 'path Obj_dir.t val virtual_ : _ t -> Modules.t Source.t option +val entry_modules : _ t -> Module_name.t list Or_exn.t Source.t + val main_module_name : _ t -> Main_module_name.t val wrapped : _ t -> Wrapped.t Inherited.t option @@ -215,6 +217,7 @@ val create : -> virtual_deps:(Loc.t * Lib_name.t) list -> dune_version:Dune_lang.Syntax.Version.t option -> virtual_:Modules.t Source.t option + -> entry_modules:Module_name.t list Or_exn.t Source.t -> implements:(Loc.t * Lib_name.t) option -> default_implementation:(Loc.t * Lib_name.t) option -> modes:Mode.Dict.Set.t diff --git a/src/dune_rules/ml_sources.ml b/src/dune_rules/ml_sources.ml index 91ab19d8a002..4ca0c5b4a71c 100644 --- a/src/dune_rules/ml_sources.ml +++ b/src/dune_rules/ml_sources.ml @@ -268,6 +268,7 @@ let make_lib_modules (d : _ Dir_with_dune.t) ~lookup_vlib ~(lib : Library.t) Modules_field_evaluator.eval ~modules ~buildable:lib.buildable ~kind ~private_modules: (Option.value ~default:Ordered_set_lang.standard lib.private_modules) + ~src_dir in let stdlib = lib.stdlib in let implements = Option.is_some lib.implements in @@ -280,20 +281,22 @@ let libs_and_exes (d : _ Dir_with_dune.t) ~lookup_vlib ~modules = match (stanza : Stanza.t) with | Library lib -> let modules = - make_lib_modules d ~lookup_vlib ~modules ~lib ~force_alias_module:false + make_lib_modules d ~lookup_vlib ~modules ~lib + ~force_alias_module:false in Left (lib, modules) | Executables exes | Tests { exes; _ } -> + let src_dir = d.ctx_dir in let modules = Modules_field_evaluator.eval ~modules ~buildable:exes.buildable ~kind:Modules_field_evaluator.Exe_or_normal_lib - ~private_modules:Ordered_set_lang.standard + ~private_modules:Ordered_set_lang.standard ~src_dir in let modules = let project = Scope.project d.scope in if Dune_project.wrapped_executables project then - Modules_group.exe_wrapped ~src_dir:d.ctx_dir ~modules + Modules_group.exe_wrapped ~src_dir ~modules else Modules_group.exe_unwrapped modules in diff --git a/src/dune_rules/module.ml b/src/dune_rules/module.ml index d2908262692b..effd8c3c28ae 100644 --- a/src/dune_rules/module.ml +++ b/src/dune_rules/module.ml @@ -339,6 +339,11 @@ let generated_alias ~src_dir name = let t = generated ~src_dir name in { t with kind = Alias } +let generated_root ~src_dir name = + let src_dir = Path.build src_dir in + let t = generated ~src_dir name in + { t with kind = Root } + let of_source ~visibility ~kind source = of_source ~visibility ~kind source module Name_map = struct diff --git a/src/dune_rules/module.mli b/src/dune_rules/module.mli index cbbff04cd56b..0ef049992356 100644 --- a/src/dune_rules/module.mli +++ b/src/dune_rules/module.mli @@ -133,3 +133,5 @@ val generated : src_dir:Path.t -> Module_name.t -> t (** Represent the generated alias module. *) val generated_alias : src_dir:Path.Build.t -> Module_name.t -> t + +val generated_root : src_dir:Path.Build.t -> Module_name.t -> t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 2c46b8b9894d..9643cd4e5f8c 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -164,6 +164,14 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = src in let modules = Compilation_context.modules cctx in + let obj_dirs = + match Module.kind m with + | Root -> [] + | _ -> + Obj_dir.all_obj_dirs obj_dir ~mode + |> List.concat_map ~f:(fun p -> + [ Command.Args.A "-I"; Path (Path.build p) ]) + in SC.add_rule sctx ~sandbox ~dir (let open Build.With_targets.O in Build.with_no_targets (Build.paths extra_deps) @@ -171,10 +179,7 @@ let build_cm cctx ~dep_graphs ~precompiled_cmi ~cm_kind (m : Module.t) ~phase = >>> Command.run ~dir:(Path.build dir) (Ok compiler) [ Command.Args.dyn flags ; cmt_args - ; Command.Args.S - ( Obj_dir.all_obj_dirs obj_dir ~mode - |> List.concat_map ~f:(fun p -> - [ Command.Args.A "-I"; Path (Path.build p) ]) ) + ; Command.Args.S obj_dirs ; Cm_kind.Dict.get (CC.includes cctx) cm_kind ; As extra_args ; ( if dynlink || cm_kind <> Cmx then @@ -318,27 +323,10 @@ let build_alias_module ~alias_module ~cctx = let root_source entries = let b = Buffer.create 128 in - let mod_ name = - Buffer.add_string b "module "; - Buffer.add_string b (Module_name.to_string name); - Buffer.add_string b " = " - in - let mod_rhs m = - Buffer.add_string b (Module_name.to_string m); - Buffer.add_char b '\n' - in - List.iter entries ~f:(fun (name, entries) -> - mod_ name; - match entries with - | [] -> assert false - | [ m ] -> mod_rhs m - | ms -> - Buffer.add_string b "struct\n"; - List.iter ms ~f:(fun m -> - Buffer.add_string b " "; - mod_ m; - mod_rhs m); - Buffer.add_string b "end\n"); + List.iter entries ~f:(fun name -> + Printf.bprintf b "module %s = %s\n" + (Module_name.to_string name) + (Module_name.to_string name)); Buffer.contents b let build_root_module root_module ~entries ~cctx = @@ -360,9 +348,7 @@ let build_all cctx ~dep_graphs = match Module.kind m with | Root -> let cctx = Compilation_context.for_root_module cctx in - let entries = - Option.value_exn (Compilation_context.root_module_entries cctx) - in + let entries = Compilation_context.root_module_entries cctx in build_root_module m ~entries ~cctx | Alias -> let cctx = Compilation_context.for_alias_module cctx in diff --git a/src/dune_rules/modules.ml b/src/dune_rules/modules.ml index 526eebecd75c..06f4fe5e5459 100644 --- a/src/dune_rules/modules.ml +++ b/src/dune_rules/modules.ml @@ -740,13 +740,16 @@ let rec wrapped = function | Impl { vlib = _; impl } -> wrapped impl let rec alias_for t m = - match t with - | Singleton _ - | Unwrapped _ -> - None - | Wrapped w -> Wrapped.alias_for w m - | Stdlib w -> Stdlib.alias_for w m - | Impl { impl; vlib = _ } -> alias_for impl m + match Module.kind m with + | Root -> None + | _ -> ( + match t with + | Singleton _ + | Unwrapped _ -> + None + | Wrapped w -> Wrapped.alias_for w m + | Stdlib w -> Stdlib.alias_for w m + | Impl { impl; vlib = _ } -> alias_for impl m ) let is_stdlib_alias t m = match t with diff --git a/src/dune_rules/modules_field_evaluator.ml b/src/dune_rules/modules_field_evaluator.ml index 97d408bc0666..bcebcc6ddd49 100644 --- a/src/dune_rules/modules_field_evaluator.ml +++ b/src/dune_rules/modules_field_evaluator.ml @@ -253,7 +253,7 @@ let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only ~modules ) let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) - ~buildable:(conf : Buildable.t) ~private_modules ~kind = + ~buildable:(conf : Buildable.t) ~private_modules ~kind ~src_dir = (* Fake modules are modules that do not exist but it doesn't matter because they are only removed from a set (for jbuild file compatibility) *) let fake_modules = ref Module_name.Map.empty in @@ -316,4 +316,8 @@ let eval ~modules:(all_modules : Module.Source.t Module_name.Map.t) in Module.of_source m ~kind ~visibility) in - all_modules + match conf.root_module with + | None -> all_modules + | Some (_, name) -> + let module_ = Module.generated_root ~src_dir name in + Module_name.Map.set all_modules name module_ diff --git a/src/dune_rules/modules_field_evaluator.mli b/src/dune_rules/modules_field_evaluator.mli index 56b1732b33fd..341056f8f547 100644 --- a/src/dune_rules/modules_field_evaluator.mli +++ b/src/dune_rules/modules_field_evaluator.mli @@ -25,4 +25,5 @@ val eval : -> buildable:Dune_file.Buildable.t -> private_modules:Ordered_set_lang.t -> kind:kind + -> src_dir:Path.Build.t -> Module.Name_map.t diff --git a/src/stdune/result.ml b/src/stdune/result.ml index 4c61bebe850c..96184350882c 100644 --- a/src/stdune/result.ml +++ b/src/stdune/result.ml @@ -106,6 +106,13 @@ module List = struct match t with | [] -> Ok init | x :: xs -> f init x >>= fun init -> fold_left xs ~f ~init + + let filter_map t ~f = + fold_left t ~init:[] ~f:(fun acc x -> + f x >>| function + | None -> acc + | Some y -> y :: acc) + >>| List.rev end let hash h1 h2 t = diff --git a/src/stdune/result.mli b/src/stdune/result.mli index 41fa8e60d84d..2ec222a66086 100644 --- a/src/stdune/result.mli +++ b/src/stdune/result.mli @@ -69,6 +69,9 @@ module List : sig -> f:('acc -> 'a -> ('acc, 'c) result) -> init:'acc -> ('acc, 'c) result + + val filter_map : + 'a list -> f:('a -> ('b option, 'error) t) -> ('b list, 'error) t end module Option : sig diff --git a/test/blackbox-tests/test-cases/rename-deps.t b/test/blackbox-tests/test-cases/rename-deps.t deleted file mode 100644 index cbf91c803df8..000000000000 --- a/test/blackbox-tests/test-cases/rename-deps.t +++ /dev/null @@ -1,231 +0,0 @@ -A library can be shadowed by an internal module name: - - $ cat >dune-project < (lang dune 2.8) - > EOF - - $ mkdir lib0 lib1 lib2 - - $ cat >lib0/dune < (library - > (name lib0)) - > EOF - $ cat >lib0/lib0.ml < let greeting_from_lib0 = "Hello World" - > EOF - - $ cat >lib1/dune < (library - > (name lib1)) - > EOF - $ cat >lib1/lib1.ml < let greeting = "Hello World" - > EOF - - $ cat >lib2/dune < (library - > (libraries lib1) - > (name lib2)) - > EOF - -Now we shadow lib1: - $ touch lib2/lib1.ml - $ cat >lib2/lib2.ml < print_endline Lib1.greeting - > EOF - - $ dune build @all - File "lib2/lib2.ml", line 1, characters 14-27: - 1 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -"identity" renaming does not change the name precedence: - - $ cat >lib2/dune < (library - > (libraries (rename lib1 -> lib1)) - > (name lib2)) - > EOF - $ cat >lib2/lib2.ml < print_endline Lib1.greeting - > EOF - $ dune build @all - File "lib2/lib2.ml", line 1, characters 14-27: - 1 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -We can use the rename dependency type to use lib1 with a different name: - - $ cat >lib2/dune < (library - > (libraries (rename lib1 -> lib1_unshadow)) - > (name lib2)) - > EOF - $ cat >lib2/lib2.ml < print_endline Lib1_unshadow.greeting - > EOF - $ dune build @all - -The same for executables: - - $ mkdir exe - $ cat >exe/dune < (executable - > (name foo) - > (libraries (rename lib1 -> lib1_unshadow))) - > EOF - $ touch exe/lib1.ml - $ cat >exe/foo.ml < print_endline Lib1_unshadow.greeting - > EOF - $ dune exec ./exe/foo.exe - Hello World - -This works for single module executables: - - $ rm exe/lib1.ml - $ dune exec ./exe/foo.exe - Hello World - -And for single module libs: - $ rm lib2/lib1.ml - $ dune build @lib2/all - -This mode is disabled for unwrapped libraries - - $ mkdir unwrapped - $ cat >unwrapped/dune < (library - > (libraries (rename lib1 -> lib1_unshadow)) - > (wrapped false) - > (name unwrapped_lib)) - > EOF - $ dune build @unwrapped/all - File "unwrapped/dune", line 2, characters 20-24: - 2 | (libraries (rename lib1 -> lib1_unshadow)) - ^^^^ - Error: rename may not be used in unwrapped libraries - [1] - - $ rm -r unwrapped - -The renamed library can not be used by its original name: - - $ cat >lib2/lib2.ml < module Lib1_empty = struct include Lib1 end;; - > print_endline Lib1.greeting - > EOF - - $ dune build @lib2/all - File "lib2/lib2.ml", line 2, characters 14-27: - 2 | print_endline Lib1.greeting - ^^^^^^^^^^^^^ - Error: Unbound value Lib1.greeting - [1] - -# CR-someday aalekseyev: I would rather [Lib1_empty] definition -# above was rejected. -# -# In jenga we achieve this by defining the lib alias like this: -# -# module Lib = Module_that_does_not_exist -# -# which has its own downsides, but we thought it was a bit better than -# an empty module. I think we also considered making it a functor -# that can't be applied, something like: -# -# module type Abstract -# module Lib1(M : Abstract) = struct end -# -# but that can be pretty confusing too. - -Implementation detail: the generated renaming module. - - $ cat _build/default/lib2/lib2__.ml-gen - module Lib1_unshadow = Lib1 - - module Lib1 = struct let this_module_is_shadowed = () end - -Multiple renamings to the same name: - - $ cat >lib2/dune < (library - > (libraries - > (rename lib0 -> lib) - > (rename lib1 -> lib) - > ) - > (name lib2)) - > EOF - - $ dune build @lib2/all - File "lib2/lib2__.ml-gen", line 3, characters 0-17: - 3 | module Lib = Lib1 - ^^^^^^^^^^^^^^^^^ - Error: Multiple definition of the module name Lib. - Names must be unique in a given structure or signature. - [1] - -# CR aalekseyev: the error above should probably be caught earlier - -Complicated library renamings where the act of renaming shadows another library: - - $ cat >lib2/dune < (library - > (libraries - > (rename lib0 -> lib1) - > (rename lib1 -> lib0) - > ) - > (name lib2)) - > EOF - - $ cat >lib2/lib2.ml < let greeting_from_lib1 = Lib0.greeting - > let greeting_from_lib0 = Lib1.greeting_from_lib0 - > EOF - - $ cat >lib2/m.ml < let x = 8 - > EOF - - $ dune build @lib2/all - File "lib2/lib2__.ml-gen", line 5, characters 0-57: - 5 | module Lib0 = struct let this_module_is_shadowed = () end - ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - Error: Multiple definition of the module name Lib0. - Names must be unique in a given structure or signature. - [1] - -# CR aalekseyev: the above should probably work? -# Or at least if it fails it should fail with a better error. -# -# Probably the way to make it work is to generate something like this: -# -# module Root____ = struct -# module Lib0 = Lib0 -# module Lib1 = Lib1 -# end -# module Lib0 = Root____.Lib1 -# module Lib1 = Root____.Lib0 -# -# (at this point, one has to wonder if Root____ is, perhaps, all we needed, after all) - -Implementation detail, the generated renaming module: - - $ cat _build/default/lib2/lib2__.ml-gen - module Lib0 = Lib1 - - module Lib1 = Lib0 - - module Lib0 = struct let this_module_is_shadowed = () end - - module Lib1 = struct let this_module_is_shadowed = () end - - (** @canonical Lib2.M *) - module M = Lib2__M - -# CR aalekseyev: should we also add a @canonical doc comment to the library renamings? -# I don't know what uses it, but if it's needed on M it's probably needed on Lib1 too. diff --git a/test/blackbox-tests/test-cases/root-module.t b/test/blackbox-tests/test-cases/root-module.t new file mode 100644 index 000000000000..34112291075e --- /dev/null +++ b/test/blackbox-tests/test-cases/root-module.t @@ -0,0 +1,77 @@ +A library can be shadowed by an internal module name: + + $ cat >dune-project < (lang dune 2.8) + > EOF + + $ mkdir lib0 lib1 lib2 + + $ cat >lib0/dune < (library + > (name lib0)) + > EOF + $ cat >lib0/lib0.ml < let greeting_from_lib0 = "Hello World" + > EOF + + $ cat >lib1/dune < (library + > (name lib1)) + > EOF + $ cat >lib1/lib1.ml < let greeting = "Hello World" + > EOF + + $ cat >lib2/dune < (library + > (libraries lib1) + > (name lib2)) + > EOF + +Now we shadow lib1: + $ cat >lib2/lib1.ml < let greeting = () + > EOF + $ cat >lib2/lib2.ml < print_endline Lib1.greeting + > EOF + + $ dune build @all + File "lib2/lib2.ml", line 1, characters 14-27: + 1 | print_endline Lib1.greeting + ^^^^^^^^^^^^^ + Error: This expression has type unit but an expression was expected of type + string + [1] + +We can use the rename dependency type to use lib1 with a different name: + + $ cat >lib2/dune < (library + > (libraries lib1) + > (root_module root) + > (name lib2)) + > EOF + $ cat >lib2/lib2.ml < print_endline Root.Lib1.greeting + > EOF + $ dune build @all + +The same for executables: + + $ mkdir exe + $ cat >exe/dune < (executable + > (name foo) + > (root_module root)) + > EOF + $ touch exe/lib1.ml + $ cat >exe/foo.ml < print_endline Root.Lib1.greeting + > EOF + $ dune exec ./exe/foo.exe + File "exe/foo.ml", line 1, characters 14-32: + 1 | print_endline Root.Lib1.greeting + ^^^^^^^^^^^^^^^^^^ + Error: Unbound module Root.Lib1 + [1]