diff --git a/bin/describe/describe_pp.ml b/bin/describe/describe_pp.ml index 569fbac95be..02f336e2804 100644 --- a/bin/describe/describe_pp.ml +++ b/bin/describe/describe_pp.ml @@ -56,7 +56,7 @@ let get_pped_file super_context file = >>| Source_tree.Dir.path >>| Path.source in - let* dune_file = Dune_rules.Dune_load.Dune_files.in_dir (dir |> in_build_dir) in + let* dune_file = Dune_rules.Dune_load.in_dir (dir |> in_build_dir) in let staged_pps = Option.bind dune_file ~f:(fun dune_file -> dune_file.stanzas diff --git a/src/dune_rules/dune_load.ml b/src/dune_rules/dune_load.ml index 603ce5e0f58..61f217a456d 100644 --- a/src/dune_rules/dune_load.ml +++ b/src/dune_rules/dune_load.ml @@ -253,34 +253,6 @@ module Dune_files = struct Memo.exec memo (dir, project, dune_file) ;; - let in_dir dir = - let source_dir = Path.Build.drop_build_context_exn dir in - Source_tree.find_dir source_dir - >>= function - | None -> Memo.return None - | Some d -> - (match Source_tree.Dir.dune_file d with - | None -> Memo.return None - | Some dune_file -> - let project = Source_tree.Dir.project d in - interpret ~dir:source_dir ~project ~dune_file - >>= (function - | Literal dune_file -> Memo.return (Some dune_file) - | Script script -> - let context = - match Install.Context.of_path dir with - | Some c -> c - | None -> - User_error.raise - [ Pp.textf - "no context in directory %s" - (Path.Build.to_string_maybe_quoted dir) - ] - in - let+ dune_file = Script.eval_one ~context script in - Some dune_file)) - ;; - let eval dune_files ~context = let open Memo.O in let static, dynamic = @@ -367,6 +339,34 @@ let load () = } ;; +let in_dir dir = + let source_dir = Path.Build.drop_build_context_exn dir in + Source_tree.find_dir source_dir + >>= function + | None -> Memo.return None + | Some d -> + (match Source_tree.Dir.dune_file d with + | None -> Memo.return None + | Some dune_file -> + let project = Source_tree.Dir.project d in + Dune_files.interpret ~dir:source_dir ~project ~dune_file + >>= (function + | Literal dune_file -> Memo.return (Some dune_file) + | Script script -> + let context = + match Install.Context.of_path dir with + | Some c -> c + | None -> + User_error.raise + [ Pp.textf + "no context in directory %s" + (Path.Build.to_string_maybe_quoted dir) + ] + in + let+ dune_file = Script.eval_one ~context script in + Some dune_file)) +;; + let load = let memo = Memo.lazy_ ~name:"dune_load" load in fun () -> Memo.Lazy.force memo diff --git a/src/dune_rules/dune_load.mli b/src/dune_rules/dune_load.mli index 7b3e7cb379c..98dd70090c0 100644 --- a/src/dune_rules/dune_load.mli +++ b/src/dune_rules/dune_load.mli @@ -10,11 +10,11 @@ module Dune_files : sig type t val eval : t -> context:Context_name.t -> Dune_file.t list Memo.t - val in_dir : Path.Build.t -> Dune_file.t option Memo.t end type t +val in_dir : Path.Build.t -> Dune_file.t option Memo.t val dune_files : t -> Dune_files.t val packages : t -> Package.t Package.Name.Map.t val projects : t -> Dune_project.t list diff --git a/src/dune_rules/only_packages.ml b/src/dune_rules/only_packages.ml index 7c774c69891..0200549fb57 100644 --- a/src/dune_rules/only_packages.ml +++ b/src/dune_rules/only_packages.ml @@ -128,7 +128,7 @@ let stanzas_in_dir dir = if Path.Build.is_root dir then Memo.return None else - Dune_load.Dune_files.in_dir dir + Dune_load.in_dir dir >>= function | None -> Memo.return None | Some dune_file ->