Merge branch 'master' of https://github.com/stephanieyou/dune into bi…

…sect-ppx

Signed-off-by: Stephanie You <youstephanie98@gmail.com>

bin/util.ml

@@ -12,8 +12,8 @@ type checked =
 
 let check_path contexts =
   let contexts =
-    Dune.Context_name.Map.of_list_exn
-      (List.map contexts ~f:(fun c -> (c.Context.name, c)))
+    Dune.Context_name.Map.of_list_map_exn contexts ~f:(fun c ->
+        (c.Context.name, c))
   in
   fun path ->
     let internal_path () =

doc/toplevel-integration.rst

@@ -2,13 +2,58 @@
 Toplevel integration
 ********************
 
-It's possible to load dune projects in any toplevel. This is achieved in two stages.
+OCaml provides a small repl to use the language interactively. We
+generally call this tool a toplevel. The compiler distribution comes
+with a small repl called simply ``ocaml`` and the community has
+developed enhanced versions such as `utop
+<https://github.com/ocaml-community/utop>`_.
 
-First, `dune toplevel-init-file` builds the project and produces a list of toplevel pragmas
-(#directory and #load). Copying the output of this command to a toplevel lets you
-interact with the project's modules.
+It's possible to load dune projects in any toplevel. To do that,
+simply execute the following in your toplevel:
+
+.. code:: ocaml
+
+    # #use_output "dune top";;
+
+``dune top`` is a dune command that builds all the libraries in the
+current directory and sub-directories and output the relevant toplevel
+directives (``#directory`` and ``#load``) to make the various modules
+available in the toplevel.
+
+Additionally, if some of the libraries are ppx rewriters the phrases
+you type in the toplevel will be rewritten with these ppx rewriters.
+
+This command is available since Dune 2.5.0.
+
+Note that the ``#use_output`` directivce is only available since OCaml
+4.11. You can add the following snippet to your ``~/.ocamlinit`` file
+to make it available in older versions of OCaml:
+
+.. code:: ocaml
+
+    let try_finally ~always f =
+      match f () with
+      | x ->
+        always ();
+        x
+      | exception e ->
+        always ();
+        raise e
+    
+    let use_output command =
+      let fn = Filename.temp_file "ocaml" "_toploop.ml" in
+      try_finally
+        ~always:(fun () -> try Sys.remove fn with Sys_error _ -> ())
+        (fun () ->
+          match
+            Printf.ksprintf Sys.command "%s > %s" command (Filename.quote fn)
+          with
+          | 0 -> ignore (Toploop.use_file Format.std_formatter fn : bool)
+          | n -> Format.printf "Command exited with code %d.@." n)
+    
+    let () =
+      let name = "use_output" in
+      if not (Hashtbl.mem Toploop.directive_table name) then
+        Hashtbl.add Toploop.directive_table name
+          (Toploop.Directive_string use_output)
 
-Second, to enhance usability, dune also provides a toplevel script, which does the above
-manual work for you. To use it, make sure to have `topfind` available in your toplevel by
-invoking `#use "topfind";;`. Afterwards you can run `#use "dune";;` and your
-modules should be available.

dune-project

@@ -1,4 +1,7 @@
 (lang dune 2.5)
+;          ^^^
+; When changing the version, don't forget to regenerate *.opam files
+; by running [dune build].
 (name dune)
 
 (generate_opam_files true)

src/cache/messages.ml

@@ -216,8 +216,8 @@ let string_of_version { major; minor } = sprintf "%i.%i" major minor
 let find_newest_common_version versions_a versions_b =
   let find a b =
     let f { major; minor } = (major, minor) in
-    let a = Int.Map.of_list_exn (List.map ~f a)
-    and b = Int.Map.of_list_exn (List.map ~f b) in
+    let a = Int.Map.of_list_map_exn ~f a
+    and b = Int.Map.of_list_map_exn ~f b in
     let common =
       Int.Map.merge
         ~f:(fun _major minor_in_a minor_in_b ->

src/dune/build_system.ml

@@ -1989,8 +1989,7 @@ let load_dir ~dir = load_dir_and_produce_its_rules ~dir
 
 let init ~contexts ?caching ~sandboxing_preference =
   let contexts =
-    List.map contexts ~f:(fun c -> (c.Context.name, c))
-    |> Context_name.Map.of_list_exn
+    Context_name.Map.of_list_map_exn contexts ~f:(fun c -> (c.Context.name, c))
   in
   let caching =
     let f ({ cache = (module Caching : Cache.Caching); _ } as v) =

src/dune/context.ml

@@ -755,29 +755,27 @@ module Create = struct
     let workspace = Workspace.workspace () in
     let rec contexts : t list Fiber.Once.t Context_name.Map.t Lazy.t =
       lazy
-        ( List.map workspace.contexts ~f:(fun context ->
-              let contexts =
-                Fiber.Once.create (fun () ->
-                    let* host_context =
-                      match Workspace.Context.host_context context with
-                      | None -> Fiber.return None
-                      | Some context -> (
-                        let+ contexts =
-                          Context_name.Map.find_exn (Lazy.force contexts)
-                            context
-                          |> Fiber.Once.get
-                        in
-                        match contexts with
-                        | [ x ] -> Some x
-                        | [] -> assert false (* checked by workspace *)
-                        | _ :: _ -> assert false
-                        (* target cannot be host *) )
-                    in
-                    instantiate_context env workspace ~context ~host_context)
-              in
-              let name = Workspace.Context.name context in
-              (name, contexts))
-        |> Context_name.Map.of_list_exn )
+        (Context_name.Map.of_list_map_exn workspace.contexts ~f:(fun context ->
+             let contexts =
+               Fiber.Once.create (fun () ->
+                   let* host_context =
+                     match Workspace.Context.host_context context with
+                     | None -> Fiber.return None
+                     | Some context -> (
+                       let+ contexts =
+                         Context_name.Map.find_exn (Lazy.force contexts) context
+                         |> Fiber.Once.get
+                       in
+                       match contexts with
+                       | [ x ] -> Some x
+                       | [] -> assert false (* checked by workspace *)
+                       | _ :: _ -> assert false
+                       (* target cannot be host *) )
+                   in
+                   instantiate_context env workspace ~context ~host_context)
+             in
+             let name = Workspace.Context.name context in
+             (name, contexts)))
     in
     Lazy.force contexts |> Context_name.Map.values
     |> Fiber.parallel_map ~f:Fiber.Once.get

src/dune/dune_file.ml

@@ -231,7 +231,7 @@ module Preprocess_map = struct
       | Preprocess.Pps { loc; pps; flags; staged } ->
         let pps = bisect_ppx :: pps in
         Preprocess.Pps { loc; pps; flags; staged }
-      | _ -> pp (* TODO: decide if this is the correct behavior *) )
+      | _ -> pp )
 end
 
 module Lint = struct

src/dune/expander.ml

@@ -35,15 +35,14 @@ let dir t = t.dir
 let make_ocaml_config ocaml_config =
   let string s = [ Value.String s ] in
   Ocaml_config.to_list ocaml_config
-  |> List.map ~f:(fun (k, v) ->
+  |> String.Map.of_list_map_exn ~f:(fun (k, v) ->
          ( k
          , match (v : Ocaml_config.Value.t) with
            | Bool x -> string (string_of_bool x)
            | Int x -> string (string_of_int x)
            | String x -> string x
            | Words x -> Value.L.strings x
            | Prog_and_args x -> Value.L.strings (x.prog :: x.args) ))
-  |> String.Map.of_list_exn
 
 let set_env t ~var ~value =
   { t with

src/dune/install_rules.ml

@@ -133,7 +133,7 @@ end = struct
             (Some loc, Install.Entry.make Stublibs a))
       ]
 
-  let keep_if ~external_lib_deps_mode expander =
+  let keep_if ~(ctx : Context.t) ~external_lib_deps_mode expander =
     if external_lib_deps_mode then
       fun ~scope:_ ->
     Option.some
@@ -155,10 +155,14 @@ end = struct
              let dune_version =
                Scope.project scope |> Dune_project.dune_version
              in
+             let pps =
+               Dune_file.Preprocess_map.pps
+                 (Dune_file.Buildable.preprocess exes.buildable
+                   ~lib_config:ctx.lib_config)
+             in
              Lib.DB.resolve_user_written_deps_for_exes (Scope.libs scope)
                exes.names exes.buildable.libraries
-               ~pps:(Dune_file.Preprocess_map.pps exes.buildable.preprocess)
-               ~dune_version
+               ~pps ~dune_version
                ~allow_overlaps:exes.buildable.allow_overlapping_dependencies
                ~variants:exes.variants ~optional:exes.optional
            in
@@ -175,7 +179,7 @@ end = struct
     let ctx = Super_context.context sctx in
     let stanzas = Super_context.stanzas sctx in
     let external_lib_deps_mode = Super_context.external_lib_deps_mode sctx in
-    let keep_if = keep_if ~external_lib_deps_mode in
+    let keep_if = keep_if ~ctx ~external_lib_deps_mode in
     let init =
       Super_context.packages sctx
       |> Package.Name.Map.map ~f:(fun (pkg : Package.t) ->

src/dune/pform.ml

@@ -439,9 +439,7 @@ module Map = struct
     { vars = String.Map.singleton k (No_info v); macros = String.Map.empty }
 
   let of_list_exn pforms =
-    { vars =
-        List.map ~f:(fun (k, x) -> (k, No_info x)) pforms
-        |> String.Map.of_list_exn
+    { vars = String.Map.of_list_map_exn ~f:(fun (k, x) -> (k, No_info x)) pforms
     ; macros = String.Map.empty
     }
 

src/dune/rules.ml

@@ -204,11 +204,11 @@ let to_map x = (x : t :> Dir_rules.t Path.Build.Map.t)
 let map t ~f =
   Path.Build.Map.map t ~f:(fun m ->
       Id.Map.to_list (m : Dir_rules.Nonempty.t :> Dir_rules.t)
-      |> List.map ~f:(fun (id, data) ->
+      |> Id.Map.of_list_map_exn ~f:(fun (id, data) ->
              match f data with
              | `No_change -> (id, data)
              | `Changed data -> (Id.gen (), data))
-      |> Id.Map.of_list_exn |> Dir_rules.Nonempty.create |> Option.value_exn)
+      |> Dir_rules.Nonempty.create |> Option.value_exn)
 
 let is_subset t ~of_ =
   Path.Build.Map.is_subset (to_map t) ~of_:(to_map of_) ~f:Dir_rules.is_subset

src/dune/super_context.ml

@@ -399,10 +399,14 @@ let get_installed_binaries stanzas ~(context : Context.t) =
         let compile_info =
           let project = Scope.project d.scope in
           let dune_version = Dune_project.dune_version project in
+          let pps =
+            Dune_file.Preprocess_map.pps
+              (Dune_file.Buildable.preprocess exes.buildable
+                ~lib_config:context.lib_config)
+          in
           Lib.DB.resolve_user_written_deps_for_exes (Scope.libs d.scope)
             exes.names exes.buildable.libraries
-            ~pps:(Dune_file.Preprocess_map.pps exes.buildable.preprocess)
-            ~dune_version
+            ~pps ~dune_version
             ~allow_overlaps:exes.buildable.allow_overlapping_dependencies
             ~variants:exes.variants ~optional:exes.optional
         in
@@ -439,9 +443,8 @@ let create ~(context : Context.t) ?host ~projects ~packages ~stanzas
         })
   in
   let stanzas_per_dir =
-    List.map stanzas ~f:(fun stanzas ->
+    Path.Build.Map.of_list_map_exn stanzas ~f:(fun stanzas ->
         (stanzas.Dir_with_dune.ctx_dir, stanzas))
-    |> Path.Build.Map.of_list_exn
   in
   let artifacts =
     let public_libs = ({ context; public_libs } : Artifacts.Public_libs.t) in

src/dune/virtual_rules.ml

@@ -74,6 +74,7 @@ let setup_copy_rules_for_impl ~sctx ~dir vimpl =
   Modules.iter_no_vlib vlib_modules ~f:(fun m -> copy_objs m)
 
 let impl sctx ~(lib : Dune_file.Library.t) ~scope =
+  let ctx = Super_context.context sctx in
   Option.map lib.implements ~f:(fun (loc, implements) ->
       match Lib.DB.find (Scope.libs scope) implements with
       | None ->
@@ -108,9 +109,13 @@ let impl sctx ~(lib : Dune_file.Library.t) ~scope =
               let dir = Lib_info.src_dir info in
               Dir_contents.get sctx ~dir
             in
+            let preprocess =
+              Dune_file.Buildable.preprocess lib.buildable
+                ~lib_config:ctx.lib_config
+            in
             let modules =
               let pp_spec =
-                Pp_spec.make lib.buildable.preprocess
+                Pp_spec.make preprocess
                   (Super_context.context sctx).version
               in
               Dir_contents.ocaml dir_contents