Skip to content

Commit

Permalink
refactor: Make [Dune_load.t] abstract (ocaml#9767)
Browse files Browse the repository at this point in the history
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
  • Loading branch information
rgrinberg authored and emillon committed Feb 5, 2024
1 parent 1afaa08 commit edb835e
Show file tree
Hide file tree
Showing 11 changed files with 31 additions and 27 deletions.
3 changes: 2 additions & 1 deletion bin/describe/describe_external_lib_deps.ml
Original file line number Diff line number Diff line change
Expand Up @@ -143,7 +143,8 @@ let libs db (context : Context.t) (build_system : Dune_rules.Main.build_system)
let { Dune_rules.Main.conf; contexts = _; _ } = build_system in
let open Memo.O in
let* dune_files =
Dune_rules.Dune_load.Dune_files.eval conf.dune_files ~context:(Context.name context)
Dune_rules.Dune_load.dune_files conf
|> Dune_rules.Dune_load.Dune_files.eval ~context:(Context.name context)
in
Memo.parallel_map dune_files ~f:(fun (dune_file : Dune_rules.Dune_file.t) ->
Memo.parallel_map dune_file.stanzas ~f:(fun stanza ->
Expand Down
9 changes: 5 additions & 4 deletions bin/describe/describe_workspace.ml
Original file line number Diff line number Diff line change
Expand Up @@ -527,7 +527,8 @@ module Crawl = struct
let sctx = Context_name.Map.find_exn scontexts context_name in
let open Memo.O in
let* dune_files =
Dune_load.Dune_files.eval conf.dune_files ~context:context_name
Dune_load.dune_files conf
|> Dune_load.Dune_files.eval ~context:context_name
>>| List.filter ~f:(dune_file_is_in_dirs dirs)
in
let* exes, exe_libs =
Expand All @@ -550,9 +551,9 @@ module Crawl = struct
in
let* project_libs =
(* the list of libraries declared in the project *)
Memo.parallel_map conf.projects ~f:(fun project ->
let* scope = Scope.DB.find_by_project context project in
Scope.libs scope |> Lib.DB.all)
Dune_load.projects conf
|> Memo.parallel_map ~f:(fun project ->
Scope.DB.find_by_project context project >>| Scope.libs >>= Lib.DB.all)
>>| Lib.Set.union_all
>>| Lib.Set.filter ~f:(lib_is_in_dirs dirs)
in
Expand Down
4 changes: 2 additions & 2 deletions bin/install_uninstall.ml
Original file line number Diff line number Diff line change
Expand Up @@ -81,9 +81,9 @@ module Workspace = struct
let get () =
let open Memo.O in
Memo.run
(let+ conf = Dune_rules.Dune_load.load ()
(let+ packages = Dune_rules.Dune_load.load () >>| Dune_rules.Dune_load.packages
and+ contexts = Context.DB.all () in
{ packages = conf.packages; contexts })
{ packages; contexts })
;;

let package_install_file t ~findlib_toolchain pkg =
Expand Down
5 changes: 5 additions & 0 deletions src/dune_rules/dune_load.ml
Original file line number Diff line number Diff line change
Expand Up @@ -300,6 +300,11 @@ type t =
; projects_by_root : Dune_project.t Path.Source.Map.t
}

let dune_files t = t.dune_files
let packages t = t.packages
let projects t = t.projects
let projects_by_root t = t.projects_by_root

module Projects_and_dune_files =
Monoid.Product
(Monoid.Appendable_list (struct
Expand Down
12 changes: 6 additions & 6 deletions src/dune_rules/dune_load.mli
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,12 @@ module Dune_files : sig
val in_dir : Path.Build.t -> Dune_file.t option Memo.t
end

type t = private
{ dune_files : Dune_files.t
; packages : Package.t Package.Name.Map.t
; projects : Dune_project.t list
; projects_by_root : Dune_project.t Path.Source.Map.t
}
type t

val dune_files : t -> Dune_files.t
val packages : t -> Package.t Package.Name.Map.t
val projects : t -> Dune_project.t list
val projects_by_root : t -> Dune_project.t Path.Source.Map.t

(** Load all dune files. This function is memoized. *)
val load : unit -> t Memo.t
Expand Down
2 changes: 1 addition & 1 deletion src/dune_rules/env_stanza_db.ml
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,7 @@ module Inherit = struct
(sprintf "%s-root" name)
~input:(module Path.Source)
(fun dir ->
let* { Dune_load.projects_by_root; _ } = Dune_load.load ()
let* projects_by_root = Dune_load.load () >>| Dune_load.projects_by_root
and* envs = Memo.Lazy.force for_context in
let project = Path.Source.Map.find_exn projects_by_root dir in
let root = root context project in
Expand Down
7 changes: 4 additions & 3 deletions src/dune_rules/lib.ml
Original file line number Diff line number Diff line change
Expand Up @@ -858,13 +858,14 @@ end = struct
let projects_by_package =
Memo.lazy_ (fun () ->
let open Memo.O in
let+ { projects; _ } = Dune_load.load () in
List.concat_map projects ~f:(fun project ->
Dune_load.load ()
>>| Dune_load.projects
>>| List.concat_map ~f:(fun project ->
Dune_project.packages project
|> Package.Name.Map.to_list_map ~f:(fun _ (pkg : Package.t) ->
let name = Package.name pkg in
name, project))
|> Package.Name.Map.of_list_exn)
>>| Package.Name.Map.of_list_exn)
;;

let instantiate_impl (db, name, info, hidden) =
Expand Down
2 changes: 1 addition & 1 deletion src/dune_rules/odoc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@ let find_project_by_key =
Memo.create "project-by-keys" ~input:(module Input) make_map
in
fun key ->
let* { projects; _ } = Dune_load.load () in
let* projects = Dune_load.load () >>| Dune_load.projects in
let+ map = Memo.exec memo projects in
Dune_project.File_key.Map.find_exn map key
;;
Expand Down
2 changes: 1 addition & 1 deletion src/dune_rules/odoc_new.ml
Original file line number Diff line number Diff line change
Expand Up @@ -485,7 +485,7 @@ module Valid = struct
;;

let get ctx ~all =
let* { projects; _ } = Dune_load.load () in
let* projects = Dune_load.load () >>| Dune_load.projects in
Memo.exec valid_libs_and_packages (ctx, all, projects)
;;

Expand Down
10 changes: 3 additions & 7 deletions src/dune_rules/only_packages.ml
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ let conf =
match Clflags.t () with
| No_restriction -> Memo.return None
| Restrict { names; command_line_option } ->
let* { packages; _ } = Dune_load.load () in
let* packages = Dune_load.load () >>| Dune_load.packages in
Package.Name.Set.iter names ~f:(fun pkg_name ->
if not (Package.Name.Map.mem packages pkg_name)
then (
Expand Down Expand Up @@ -105,9 +105,7 @@ let filtered_stanzas =
Per_context.create_by_name ~name:"filtered_stanzas"
@@ fun context ->
let* only_packages = Memo.Lazy.force conf
and+ { Dune_load.dune_files; packages = _; projects = _; projects_by_root = _ } =
Dune_load.load ()
in
and+ dune_files = Dune_load.load () >>| Dune_load.dune_files in
let+ stanzas = Dune_load.Dune_files.eval ~context dune_files in
match only_packages with
| None -> stanzas
Expand All @@ -121,9 +119,7 @@ let filtered_stanzas =
;;

let get () =
let* { Dune_load.dune_files = _; packages; projects = _; projects_by_root = _ } =
Dune_load.load ()
in
let* packages = Dune_load.load () >>| Dune_load.packages in
let+ only_packages = Memo.Lazy.force conf in
Option.value only_packages ~default:packages
;;
Expand Down
2 changes: 1 addition & 1 deletion src/dune_rules/scope.ml
Original file line number Diff line number Diff line change
Expand Up @@ -336,7 +336,7 @@ module DB = struct
let scopes =
Memo.Lazy.create
@@ fun () ->
let* { Dune_load.projects_by_root; _ } = Dune_load.load () in
let* projects_by_root = Dune_load.load () >>| Dune_load.projects_by_root in
let* stanzas = Only_packages.filtered_stanzas (Context.name context) in
create_from_stanzas ~projects_by_root ~context stanzas
in
Expand Down

0 comments on commit edb835e

Please sign in to comment.