refactor: move predicate_with_id to engine

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: 18932E72-064F-40DD-9DEF-BEB5F8E591C8

src/dune_engine/action_exec.ml

@@ -17,9 +17,7 @@ module Dynamic_dep = struct
 
     let to_dep = function
       | File fn -> Dep.file fn
-      | Glob (dir, glob) ->
-        Glob.to_predicate_with_id glob
-        |> File_selector.create ~dir |> Dep.file_selector
+      | Glob (dir, glob) -> File_selector.of_glob ~dir glob |> Dep.file_selector
 
     let of_DAP_dep ~loc ~working_dir : DAP.Dependency.t -> t =
       let to_dune_path = Path.relative working_dir in

src/dune_engine/dep.ml

@@ -312,7 +312,8 @@ module Set = struct
      depending on [(source_tree x)]. Otherwise, we wouldn't clean up stale
      directories in directories that contain no file. *)
   let dir_without_files_dep dir =
-    file_selector (File_selector.create ~dir Predicate_with_id.false_)
+    file_selector
+      (File_selector.create ~dir File_selector.Predicate_with_id.false_)
 
   module Source_tree_map_reduce =
     Source_tree.Dir.Make_map_reduce (Memo) (Monoid.Union (M))
@@ -345,9 +346,9 @@ module Set = struct
           | File f -> Path.Set.add acc f
           | File_selector fs ->
             assert (
-              Predicate_with_id.equal
+              File_selector.Predicate_with_id.equal
                 (File_selector.predicate fs)
-                Predicate_with_id.false_);
+                File_selector.Predicate_with_id.false_);
             acc
           | _ -> assert false)
     in

src/dune_engine/file_selector.ml

@@ -1,5 +1,35 @@
 open Import
 
+module Predicate_with_id = struct
+  open Stdune
+  open Dune_sexp
+
+  type 'a t =
+    { id : Dyn.t Lazy.t
+    ; f : 'a Predicate.t
+    }
+
+  let compare x y = Dyn.compare (Lazy.force x.id) (Lazy.force y.id)
+
+  let equal x y = compare x y = Ordering.Eq
+
+  let hash t = Dyn.hash (Lazy.force t.id)
+
+  let to_dyn t =
+    let open Dyn in
+    Record [ ("id", Lazy.force t.id) ]
+
+  let encode _ = Encoder.string "predicate <opaque>"
+
+  let create ~id ~f = { id; f = Predicate.create f }
+
+  let true_ = { id = lazy (String "true_"); f = Predicate.true_ }
+
+  let false_ = { id = lazy (String "false_"); f = Predicate.false_ }
+
+  let test t e = Predicate.test t.f e
+end
+
 type t =
   { dir : Path.t
   ; predicate : Filename.t Predicate_with_id.t
@@ -21,6 +51,10 @@ let compare { dir; predicate; only_generated_files } t =
 let create ~dir ?(only_generated_files = false) predicate =
   { dir; predicate; only_generated_files }
 
+let of_glob ~dir glob =
+  let id = lazy (Glob.to_dyn glob) in
+  create ~dir (Predicate_with_id.create ~id ~f:(Glob.test glob))
+
 let to_dyn { dir; predicate; only_generated_files } =
   Dyn.Record
     [ ("dir", Path.to_dyn dir)

src/dune_engine/file_selector.mli

@@ -3,6 +3,28 @@
 
 open Import
 
+(** TODO get rid of this *)
+module Predicate_with_id : sig
+  (** Predicates are functions from 'a -> bool along with a uniquely identifying
+      string. The uniquely identifying string allows us to safely memoize on the
+      predicate *)
+
+  type 'a t
+
+  val equal : 'a t -> 'a t -> bool
+
+  (**[create id ~f] creates a predicate defined by [f] identified uniquely with
+     [id]. [id] is used to safely compare predicates for equality for
+     memoization *)
+  val create : id:Dyn.t Lazy.t -> f:('a -> bool) -> 'a t
+
+  (** The predicate that evaluates to [true] for any query. *)
+  val true_ : _ t
+
+  (** The predicate that evaluates to [false] for any query. *)
+  val false_ : _ t
+end
+
 type t
 
 val dir : t -> Path.t
@@ -11,6 +33,8 @@ val predicate : t -> Filename.t Predicate_with_id.t
 
 val only_generated_files : t -> bool
 
+val of_glob : dir:Path.t -> Glob.t -> t
+
 val create :
      dir:Path.t
   -> ?only_generated_files:bool

src/dune_engine/import.ml

@@ -10,7 +10,6 @@ module Cm_kind = Ocaml.Cm_kind
 module Mode = Ocaml.Mode
 module Config = Dune_util.Config
 module Predicate_lang = Dune_lang.Predicate_lang
-module Predicate_with_id = Dune_lang.Predicate_with_id
 module Glob = Dune_lang.Glob
 include No_io
 

src/dune_lang/dune_lang.ml

@@ -2,7 +2,6 @@ include Dune_sexp
 module Format = Format
 module Stanza = Stanza
 module Predicate_lang = Predicate_lang
-module Predicate_with_id = Predicate_with_id
 module Glob = Glob
 
 (* TODO remove the [Dune] prefix *)

src/dune_lang/glob.ml

@@ -6,14 +6,14 @@ let of_string = `shadowed
 
 let _ = of_string
 
+let to_dyn t = Dyn.variant "Glob" [ Dyn.string (to_string t) ]
+
 let compare x y = String.compare (to_string x) (to_string y)
 
 let equal x y = String.equal (to_string x) (to_string y)
 
 let hash t = String.hash (to_string t)
 
-let to_dyn t = Dyn.string (to_string t)
-
 let of_string_exn loc repr =
   match of_string_result repr with
   | Error (_, msg) -> User_error.raise ~loc [ Pp.textf "invalid glob: %s" msg ]
@@ -30,7 +30,3 @@ let decode =
 let filter t = List.filter ~f:(test t)
 
 let to_predicate t = Predicate.create (test t)
-
-let to_predicate_with_id t =
-  let id = lazy (Dyn.variant "Glob" [ String (to_string t) ]) in
-  Predicate_with_id.create ~id ~f:(test t)

src/dune_lang/glob.mli

@@ -26,5 +26,3 @@ val universal : t
 val of_string_exn : Loc.t -> string -> t
 
 val to_predicate : t -> Filename.t Predicate.t
-
-val to_predicate_with_id : t -> Filename.t Predicate_with_id.t

src/dune_lang/predicate_lang.ml

@@ -115,18 +115,6 @@ let to_predicate (type a) (t : a Predicate.t t) ~standard : a Predicate.t =
   Predicate.create (fun a ->
       exec t ~standard (fun pred -> Predicate.test pred a))
 
-let to_predicate_with_id (type a) (t : a Predicate_with_id.t t) ~standard :
-    a Predicate_with_id.t =
-  let id =
-    lazy
-      (Dyn.variant "Predicate_lang.to_predicate"
-         [ to_dyn Predicate_with_id.to_dyn standard
-         ; to_dyn Predicate_with_id.to_dyn t
-         ])
-  in
-  Predicate_with_id.create ~id ~f:(fun a ->
-      exec t ~standard (fun pred -> Predicate_with_id.test pred a))
-
 module Glob = struct
   type glob = string -> bool
 

src/dune_lang/predicate_lang.mli

@@ -36,11 +36,6 @@ val empty : 'a t
 
 val map : 'a t -> f:('a -> 'b) -> 'b t
 
-val to_predicate_with_id :
-     'a Predicate_with_id.t t
-  -> standard:'a Predicate_with_id.t t
-  -> 'a Predicate_with_id.t
-
 val to_predicate :
   'a Predicate.t t -> standard:'a Predicate.t t -> 'a Predicate.t
 

src/dune_rules/check_rules.ml

@@ -7,7 +7,7 @@ let dev_files =
       (let open Dyn in
       variant "dev_files" (List.map ~f:string exts))
   in
-  Dune_lang.Predicate_with_id.create ~id ~f:(fun p ->
+  Predicate_with_id.create ~id ~f:(fun p ->
       let ext = Filename.extension p in
       List.mem exts ext ~equal:String.equal)
 

src/dune_rules/coq_rules.ml

@@ -431,9 +431,8 @@ let coqdoc_rule (cctx : _ Context.t) ~sctx ~name:(_, name) ~file_flags ~mode
             let+ theory_dirs = Context.directories_of_lib ~sctx theory in
             Dep.Set.of_list_map theory_dirs ~f:(fun dir ->
                 (* TODO *)
-                Glob.of_string_exn Loc.none "*.{glob}"
-                |> Glob.to_predicate_with_id
-                |> File_selector.create ~dir:(Path.build dir)
+                Glob.of_string_exn Loc.none "*.glob"
+                |> File_selector.of_glob ~dir:(Path.build dir)
                 |> Dep.file_selector))
       in
       Command.Args.Hidden_deps (Dep.Set.union_all deps)

src/dune_rules/dep_conf_eval.ml

@@ -140,15 +140,13 @@ let rec dep expander = function
     Other
       (let loc = String_with_vars.loc s in
        let* path = Expander.expand_path expander s in
-       let pred =
-         Path.basename path |> Glob.of_string_exn loc
-         |> Glob.to_predicate_with_id
-       in
-       let dir = Path.parent_exn path in
-       let files_in dir =
-         Action_builder.paths_matching ~loc (File_selector.create ~dir pred)
+       let files_in =
+         let glob = Path.basename path |> Glob.of_string_exn loc in
+         fun dir ->
+           Action_builder.paths_matching ~loc (File_selector.of_glob ~dir glob)
        in
        let+ files =
+         let dir = Path.parent_exn path in
          if recursive then collect_source_files_recursively dir ~f:files_in
          else files_in dir
        in

src/dune_rules/foreign_rules.ml

@@ -63,7 +63,7 @@ let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) =
                    Dep.Set.singleton
                      (Dep.file_selector
                         (File_selector.create ~dir:include_dir
-                           Dune_lang.Predicate_with_id.true_))
+                           Predicate_with_id.true_))
                  in
                  Command.Args.Hidden_deps deps
                | Some (build_dir, source_dir) ->

src/dune_rules/gen_rules.ml

@@ -192,7 +192,7 @@ let define_all_alias ~dir ~scope ~js_targets =
             (List.exists js_targets ~f:(fun js_target ->
                  String.equal (Path.Build.basename js_target) basename))
       in
-      Dune_lang.Predicate_with_id.create ~id ~f
+      Predicate_with_id.create ~id ~f
     in
     let only_generated_files =
       Dune_project.dune_version (Scope.project scope) >= (3, 0)

src/dune_rules/import.ml

@@ -11,6 +11,6 @@ include Ocaml
 module Re = Dune_re
 module Stanza = Dune_lang.Stanza
 module Predicate_lang = Dune_lang.Predicate_lang
-module Predicate_with_id = Dune_lang.Predicate_with_id
+module Predicate_with_id = Dune_engine.File_selector.Predicate_with_id
 module Glob = Dune_lang.Glob
 include Dune_engine.No_io

src/dune_rules/lib_file_deps.ml

@@ -30,7 +30,7 @@ module Group = struct
               variant "Lib_file_deps" [ string ext ])
           in
           let pred =
-            Dune_lang.Predicate_with_id.create ~id ~f:(fun p ->
+            Predicate_with_id.create ~id ~f:(fun p ->
                 String.equal (Filename.extension p) ext)
           in
           (g, pred))

src/dune_rules/simple_rules.ml

@@ -159,10 +159,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
            (Path.to_string_maybe_quoted glob_in_src)
            (Path.Source.to_string_maybe_quoted src_dir));
   let src_in_src = Path.parent_exn glob_in_src in
-  let pred =
-    Path.basename glob_in_src |> Glob.of_string_exn loc
-    |> Glob.to_predicate_with_id
-  in
+  let glob = Path.basename glob_in_src |> Glob.of_string_exn loc in
   let src_in_build =
     match Path.as_in_source_tree src_in_src with
     | None -> src_in_src
@@ -190,7 +187,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
       ];
   (* add rules *)
   let* files =
-    Build_system.eval_pred (File_selector.create ~dir:src_in_build pred)
+    Build_system.eval_pred (File_selector.of_glob ~dir:src_in_build glob)
   in
   (* CR-someday amokhov: We currently traverse the set [files] twice: first, to
      add the corresponding rules, and then to convert the files to [targets]. To