feature: load modules in the toplevel

introduce a $ dune ocaml top-module command to load modules directly

Signed-off-by: Rudi Grinberg <[email protected]>

ps-id: 79f4ac2d-0e7b-4983-9bee-c410d534bc8e

CHANGES.md

@@ -1,6 +1,9 @@
 3.4.0 (Unreleased)
 ------------------
 
+- Introduce a `$ dune ocaml top-module` subcommand to load modules directly
+  without sealing them behind the signature. (#5940, @rgrinberg)
+
 - Building the `@check` alias should make sure the libraries and executables
   don't have dependency cycles (#5892, @rgrinberg)
 

bin/ocaml_cmd.ml

@@ -8,5 +8,6 @@ let group =
       ; in_group Ocaml_merlin.command
       ; in_group Ocaml_merlin.Dump_dot_merlin.command
       ; in_group Top.command
+      ; in_group Top.module_command
       ]
   , info )

bin/top.ml

@@ -23,6 +23,18 @@ let link_deps sctx link =
       Dune_rules.Lib_flags.link_deps sctx t Dune_rules.Link_mode.Byte)
   >>| List.concat
 
+let files_to_load_of_requires sctx requires =
+  let open Memo.O in
+  let* files = link_deps sctx requires in
+  let+ () =
+    Memo.parallel_iter files ~f:(fun file ->
+        let+ (_ : Digest.t) = Build_system.build_file file in
+        ())
+  in
+  List.filter files ~f:(fun p ->
+      let ext = Path.extension p in
+      ext = Ocaml.Mode.compiled_lib_ext Byte || ext = Ocaml.Cm_kind.ext Cmo)
+
 let term =
   let+ common = Common.term
   and+ dir = Arg.(value & pos 0 string "" & Arg.info [] ~docv:"DIR")
@@ -58,19 +70,193 @@ let term =
           let include_paths =
             Dune_rules.Lib_flags.L.toplevel_include_paths requires
           in
-          let* files = link_deps sctx requires in
-          let+ () =
-            Memo.parallel_iter files ~f:(fun file ->
-                let+ (_ : Digest.t) = Build_system.build_file file in
-                ())
-          in
-          let files_to_load =
-            List.filter files ~f:(fun p ->
-                let ext = Path.extension p in
-                ext = Ocaml.Mode.compiled_lib_ext Byte
-                || ext = Ocaml.Cm_kind.ext Cmo)
-          in
+          let+ files_to_load = files_to_load_of_requires sctx requires in
           Dune_rules.Toplevel.print_toplevel_init_file ~include_paths
-            ~files_to_load))
+            ~files_to_load ~uses:[] ~pp:None ~ppx:None))
 
 let command = (term, info)
+
+module Module = struct
+  let doc =
+    "Print a list of toplevel directives for loading a module into the topevel."
+
+  let man =
+    [ `S "DESCRIPTION"
+    ; `P doc
+    ; `P
+        "The module's source is evaluated in the toplevel without being sealed \
+         by the mli."
+    ; `P
+        {|The output of $(b,dune toplevel-init-file) should be evaluated in a toplevel
+          to make the module available there.|}
+    ; `Blocks Common.help_secs
+    ]
+
+  let info = Term.info "top-module" ~doc ~man
+
+  let module_directives sctx mod_ =
+    let ctx = Super_context.context sctx in
+    let src = Path.Build.append_source ctx.build_dir mod_ in
+    let dir = Path.Build.parent_exn src in
+    let open Memo.O in
+    let module_name =
+      let name = src |> Path.Build.basename |> Filename.chop_extension in
+      match Dune_rules.Module_name.of_string_user_error (Loc.none, name) with
+      | Ok s -> s
+      | Error e -> raise (User_error.E e)
+    in
+    let drop_rules f =
+      let+ res, _ =
+        Memo.Implicit_output.collect Dune_engine.Rules.implicit_output f
+      in
+      res
+    in
+    let* dir_contents =
+      drop_rules @@ fun () -> Dune_rules.Dir_contents.get sctx ~dir
+    in
+    let* ocaml = Dune_rules.Dir_contents.ocaml dir_contents in
+    let stanza =
+      match Dune_rules.Ml_sources.lookup_stanza_module ocaml module_name with
+      | None -> User_error.raise [ Pp.text "" ]
+      | Some m -> m
+    in
+    let* scope = Dune_rules.Scope.DB.find_by_dir dir in
+    let* expander = Super_context.expander sctx ~dir in
+    let* cctx, merlin =
+      drop_rules @@ fun () ->
+      match stanza with
+      | `Executables exes ->
+        Dune_rules.Exe_rules.rules ~sctx ~dir ~dir_contents ~scope ~expander
+          exes
+      | `Library lib ->
+        Dune_rules.Lib_rules.rules lib ~sctx ~dir_contents ~dir ~expander ~scope
+    in
+    let modules = Dune_rules.Compilation_context.modules cctx in
+    let module_ =
+      match Dune_rules.Modules.find modules module_name with
+      | Some m -> m
+      | None -> User_error.raise [ Pp.textf "module not found" ]
+    in
+    let obj_dir = Dune_rules.Compilation_context.obj_dir cctx in
+    let* compile =
+      match stanza with
+      | `Executables exes -> Dune_rules.Exe_rules.compile_info ~scope exes
+      | `Library lib ->
+        let libs = Dune_rules.Scope.libs scope in
+        let+ _, compile =
+          Dune_rules.Lib.DB.get_compile_info libs
+            (Dune_rules.Dune_file.Library.best_name lib)
+            ~allow_overlaps:lib.buildable.allow_overlapping_dependencies
+        in
+        compile
+    in
+    let* requires =
+      let* requires =
+        Dune_rules.Lib.Compile.requires_link compile |> Memo.Lazy.force
+      in
+      Dune_rules.Resolve.read_memo requires
+    in
+    let include_paths =
+      let libs = Dune_rules.Lib_flags.L.toplevel_include_paths requires in
+      let modules = Dune_rules.Obj_dir.all_cmis obj_dir in
+      Path.Set.union libs (Path.Set.of_list_map modules ~f:Path.build)
+    in
+    let source_deps =
+      (* We this explicit dep for two reasons:
+
+         - to copy the source file to the build dir if ocamldep doesn't require
+         it to compute the deps (single module exes for example)
+
+         - To force building the preprocessor so that the repl can use it. It's
+         kind of a hack since we don't need to preprocess the source, but it's
+         the easiest way to do it
+      *)
+      match Dune_rules.Module.file module_ ~ml_kind:Impl with
+      | None -> User_error.raise [ Pp.text "" ]
+      | Some f ->
+        fun () ->
+          let+ (_ : Digest.t) = Build_system.build_file f in
+          ()
+    in
+    let files_to_load () =
+      let+ libs, modules =
+        Memo.fork_and_join
+          (fun () -> files_to_load_of_requires sctx requires)
+          (fun () ->
+            let dep_graph =
+              let dg = Dune_rules.Compilation_context.dep_graphs cctx in
+              Ocaml.Ml_kind.Dict.get dg Impl
+            in
+            let* files =
+              let+ module_deps =
+                let action = Dune_rules.Dep_graph.deps_of dep_graph module_ in
+                let+ graph, _ = Action_builder.run action Eager in
+                graph
+              in
+              List.filter_map module_deps ~f:(fun module_ ->
+                  Dune_rules.Obj_dir.Module.cm_file obj_dir module_ ~kind:Cmo
+                  |> Option.map ~f:Path.build)
+            in
+            let+ () =
+              Memo.parallel_iter files ~f:(fun file ->
+                  let+ (_ : Digest.t) = Build_system.build_file file in
+                  ())
+            in
+            files)
+      in
+      libs @ modules
+    in
+    let pps () =
+      let module Merlin = Dune_rules.Merlin in
+      let pps = Merlin.pp_config merlin sctx ~expander in
+      let+ pps, _ = Action_builder.run pps Eager in
+      let pp = Dune_rules.Module_name.Per_item.get pps module_name in
+      match pp with
+      | None -> (None, None)
+      | Some pp_flags -> (
+        let args = Merlin.Processed.pp_args pp_flags in
+        match Merlin.Processed.pp_kind pp_flags with
+        | Pp -> (Some args, None)
+        | Ppx -> (None, Some args))
+    in
+    let+ (pp, ppx), files_to_load =
+      Memo.fork_and_join pps (fun () ->
+          Memo.fork_and_join_unit source_deps files_to_load)
+    in
+    (include_paths, files_to_load, src, pp, ppx)
+
+  let term =
+    let+ common = Common.term
+    and+ module_path =
+      Arg.(value & pos 0 string "" & Arg.info [] ~docv:"MODULE")
+    and+ ctx_name =
+      Common.context_arg ~doc:{|Select context where to build/run utop.|}
+    in
+    let config = Common.init common in
+    Scheduler.go ~common ~config (fun () ->
+        let open Fiber.O in
+        let* setup = Import.Main.setup () in
+        Build_system.run_exn (fun () ->
+            let open Memo.O in
+            let* setup = setup in
+            let sctx =
+              Dune_engine.Context_name.Map.find setup.scontexts ctx_name
+              |> Option.value_exn
+            in
+            let+ include_paths, files_to_load, use, pp, ppx =
+              let module_path =
+                let root = Common.root common in
+                Path.Source.relative Path.Source.root
+                  (root.reach_from_root_prefix ^ module_path)
+              in
+              module_directives sctx module_path
+            in
+            Dune_rules.Toplevel.print_toplevel_init_file ~include_paths
+              ~files_to_load
+              ~uses:[ Path.build use ]
+              ~pp ~ppx))
+
+  let command = (term, info)
+end
+
+let module_command = Module.command

bin/top.mli

@@ -1 +1,3 @@
 val command : unit Cmdliner.Term.t * Cmdliner.Term.info
+
+val module_command : unit Cmdliner.Term.t * Cmdliner.Term.info

doc/toplevel-integration.rst

@@ -25,6 +25,17 @@ you type in the toplevel will be rewritten with these PPX rewriters.
 
 This command became available with Dune 2.5.0.
 
+It's also possible to load individual modules (since dune 3.4.0) for
+interactive development. Use the following dune command:
+
+.. code:: ocaml
+
+  # #use_output "dune ocaml top-module foo.ml";;
+
+This will print directives that will load ``foo.ml`` without sealing it behind
+``foo.mli``. This is particularly useful for peeking and prodding at a module's
+internals.
+
 Note that the ``#use_output`` directive has only been available since OCaml 4.11. You
 can add the following snippet to your ``~/.ocamlinit`` file to make it available
 in older versions of OCaml:

src/dune_rules/dune_rules.ml

@@ -1,6 +1,7 @@
 module Main = Main
 module Context = Context
 module Super_context = Super_context
+module Compilation_context = Compilation_context
 module Findlib = Findlib
 module Colors = Colors
 module Profile = Profile
@@ -14,6 +15,7 @@ module Lib_flags = Lib_flags
 module Lib_info = Lib_info
 module Modules = Modules
 module Exe_rules = Exe_rules
+module Lib_rules = Lib_rules
 module Obj_dir = Obj_dir
 module Merlin_ident = Merlin_ident
 module Merlin = Merlin
@@ -34,6 +36,8 @@ module Global = Global
 module Only_packages = Only_packages
 module Resolve = Resolve
 module Ocamldep = Ocamldep
+module Dep_rules = Dep_rules
+module Dep_graph = Dep_graph
 module Preprocess = Preprocess
 module Coq_rules = Coq_rules
 module Coq_module = Coq_module