Merge pull request #922 from rgrinberg/persistent-build-files

Use Util.Persistent to reimplemented promoted files store

bin/main.ml

@@ -804,7 +804,7 @@ let clean =
     begin
       set_common common ~targets:[];
       Build_system.files_in_source_tree_to_delete ()
-      |> List.iter ~f:Path.unlink_no_err;
+      |> Path.Set.iter ~f:Path.unlink_no_err;
       Path.rm_rf Path.build_dir
     end
   in

src/action.ml

@@ -611,7 +611,8 @@ module Promotion = struct
       ; dst : Path.t
       }
 
-    let t =
+    (* XXX these sexp converters will be useful for the dump command *)
+    let _t =
       let open Sexp.Of_sexp in
       peek_exn >>= function
       | List (_, [_; Atom (_, A "as"); _]) ->
@@ -624,7 +625,7 @@ module Promotion = struct
         Sexp.Of_sexp.of_sexp_errorf (Sexp.Ast.loc sexp)
           "(<file> as <file>) expected"
 
-    let sexp_of_t { src; dst } =
+    let _sexp_of_t { src; dst } =
       Sexp.List [Path.sexp_of_t src; Sexp.unsafe_atom_of_string "as";
                  Path.sexp_of_t dst]
 
@@ -639,26 +640,22 @@ module Promotion = struct
       Io.copy_file ~src ~dst
   end
 
+  module P = Utils.Persistent(struct
+      type t = File.t list
+      let name = "TO-PROMOTE"
+      let version = 1
+    end)
+
   let db_file = Path.relative Path.build_dir ".to-promote"
 
   let dump_db db =
     if Path.build_dir_exists () then begin
       match db with
       | [] -> if Path.exists db_file then Path.unlink_no_err db_file
-      | l ->
-        Io.write_file db_file
-          (String.concat ~sep:""
-             (List.map l ~f:(fun x ->
-                Sexp.to_string ~syntax:Dune (File.sexp_of_t x) ^ "\n")))
+      | l -> P.dump db_file l
     end
 
-  let load_db () =
-    if Path.exists db_file then
-      Sexp.Of_sexp.(
-        parse (list File.t) Univ_map.empty
-          (Io.Sexp.load db_file ~mode:Many_as_one))
-    else
-      []
+  let load_db () = Option.value ~default:[] (P.load db_file)
 
   let group_by_targets db =
     List.map db ~f:(fun { File. src; dst } ->

src/build_system.ml

@@ -10,26 +10,26 @@ let alias_dir = Path.(relative build_dir) ".aliases"
 let misc_dir = Path.(relative build_dir) ".misc"
 
 module Promoted_to_delete = struct
-  let db = ref []
+  module P = Utils.Persistent(struct
+      type t = Path.Set.t
+      let name = "PROMOTED-TO-DELETE"
+      let version = 1
+    end)
+
+  let db = ref Path.Set.empty
 
   let fn = Path.relative Path.build_dir ".to-delete-in-source-tree"
 
-  let add p = db := p :: !db
+  let add p = db := Path.Set.add !db p
 
   let load () =
-    if Path.exists fn then
-      Io.Sexp.load fn ~mode:Many
-      |> List.map ~f:(Sexp.Of_sexp.parse Path.t Univ_map.empty)
-    else
-      []
+    Option.value ~default:Path.Set.empty (P.load fn)
 
   let dump () =
-    let db = Path.Set.union (Path.Set.of_list !db) (Path.Set.of_list (load ())) in
     if Path.build_dir_exists () then
-      Io.write_file fn
-        (String.concat ~sep:""
-           (List.map (Path.Set.to_list db) ~f:(fun p ->
-              Sexp.to_string ~syntax:Dune (Path.sexp_of_t p) ^ "\n")))
+      load ()
+      |> Path.Set.union !db
+      |> P.dump fn
 end
 
 let files_in_source_tree_to_delete () =
@@ -447,8 +447,8 @@ let get_file : type a. t -> Path.t -> a File_kind.t -> a File_spec.t = fun t fn
     let Eq = File_kind.eq_exn kind file.kind in
     file
 
-let vfile_to_string (type a) (module K : Vfile_kind.S with type t = a) fn x =
-  K.to_string fn x
+let vfile_to_string (type a) (module K : Vfile_kind.S with type t = a) _fn x =
+  K.to_string x
 
 module Build_exec = struct
   open Build.Repr

src/build_system.mli

@@ -204,11 +204,11 @@ val all_lib_deps_by_context
 (** List of all buildable targets *)
 val all_targets : t -> Path.t list
 
-(** Return the list of files that were created in the source tree and
+(** Return the set of files that were created in the source tree and
     needs to be deleted *)
 val files_in_source_tree_to_delete
   :  unit
-  -> Path.t list
+  -> Path.Set.t
 
 (** {2 Build rules} *)
 

src/super_context.ml

@@ -534,10 +534,11 @@ end
 module Pkg_version = struct
   open Build.O
 
-  module V = Vfile_kind.Make(struct type t = string option end)
-      (functor (C : Sexp.Combinators) -> struct
-        let t = C.option C.string
-      end)
+  module V = Vfile_kind.Make(struct
+      type t = string option
+      let t = Sexp.To_sexp.(option string)
+      let name = "Pkg_version"
+    end)
 
   let spec sctx (p : Package.t) =
     let fn =

src/utils.ml

@@ -155,6 +155,9 @@ end
 module Persistent(D : Persistent_desc) = struct
   let magic = sprintf "DUNE-%sv%d:" D.name D.version
 
+  let to_out_string (v : D.t) =
+    magic ^ Marshal.to_string v []
+
   let dump file (v : D.t) =
     Io.with_file_out file ~f:(fun oc ->
       output_string oc magic;

src/utils.mli

@@ -63,6 +63,7 @@ end
 
 (** Persistent value stored on disk *)
 module Persistent(D : Persistent_desc) : sig
+  val to_out_string : D.t -> string
   val dump : Path.t -> D.t -> unit
   val load : Path.t -> D.t option
 end

src/vfile_kind.ml

@@ -32,7 +32,7 @@ module type S = sig
   val id : t Id.t
 
   val load : Path.t -> t
-  val to_string : Path.t -> t -> string
+  val to_string : t -> string
 end
 
 type 'a t = (module S with type t = 'a)
@@ -42,37 +42,29 @@ let eq (type a) (type b)
       (module B : S with type t = b) =
   Id.eq A.id B.id
 
-module Make_full
-    (T : sig type t end)
-    (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
-    (Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end)
+module Make
+    (T : sig
+       type t
+       val t : t Sexp.To_sexp.t
+       val name : string
+     end)
   : S with type t = T.t =
 struct
   type t = T.t
 
+  (* XXX dune dump should make use of this *)
+  let _t = T.t
+
+  module P = Utils.Persistent(struct
+      type nonrec t = t
+      let name = "VFILE_KIND-" ^ T.name
+      let version = 1
+    end)
+
   let id = Id.create ()
 
-  let to_string path x = To_sexp.t path x |> Sexp.to_string ~syntax:Dune
+  let to_string x = P.to_out_string x
 
-  let load path =
-    Of_sexp.t path (Io.Sexp.load path ~mode:Single)
-end
-
-
-module Make
-    (T : sig type t end)
-    (F : functor (C : Sexp.Combinators) -> sig val t : T.t C.t end)
-  : S with type t = T.t =
-struct
-  module Of_sexp = struct
-    include F(Sexp.Of_sexp)
-    let t _ sexp = Sexp.Of_sexp.parse t Univ_map.empty sexp
-  end
-  module To_sexp = struct
-    include F(Sexp.To_sexp)
-    let t _ x = t x
-  end
-
-  include Make_full(T)(To_sexp)(Of_sexp)
+  let load path = Option.value_exn (P.load path)
 end
 

src/vfile_kind.mli

@@ -12,7 +12,7 @@ module type S = sig
   val id : t Id.t
 
   val load : Path.t -> t
-  val to_string : Path.t -> t -> string
+  val to_string : t -> string
 end
 
 type 'a t = (module S with type t = 'a)
@@ -20,12 +20,9 @@ type 'a t = (module S with type t = 'a)
 val eq : 'a t -> 'b t -> ('a, 'b) eq option
 
 module Make
-    (T : sig type t end)
-    (F : functor (C : Sexp.Combinators) -> sig val t : T.t C.t end)
-  : S with type t = T.t
-
-module Make_full
-    (T : sig type t end)
-    (To_sexp : sig val t : Path.t -> T.t -> Sexp.t end)
-    (Of_sexp : sig val t : Path.t -> Sexp.Ast.t -> T.t end)
+    (T : sig
+       type t
+       val t : t Sexp.To_sexp.t
+       val name : string
+     end)
   : S with type t = T.t