diff --git a/bin/main.ml b/bin/main.ml index 7e5d872b..07c9479f 100644 --- a/bin/main.ml +++ b/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 diff --git a/src/action.ml b/src/action.ml index 82768fde..0f68ebe5 100644 --- a/src/action.ml +++ b/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) "( as ) 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 } -> diff --git a/src/build_system.ml b/src/build_system.ml index 80c8f56f..16e655fb 100644 --- a/src/build_system.ml +++ b/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 diff --git a/src/build_system.mli b/src/build_system.mli index 4abbcd2b..631122ee 100644 --- a/src/build_system.mli +++ b/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} *) diff --git a/src/super_context.ml b/src/super_context.ml index 5f883bbe..fab6f655 100644 --- a/src/super_context.ml +++ b/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 = diff --git a/src/utils.ml b/src/utils.ml index c8fb0a8b..2c9f22d6 100644 --- a/src/utils.ml +++ b/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; diff --git a/src/utils.mli b/src/utils.mli index d7b167dc..a5bf7cee 100644 --- a/src/utils.mli +++ b/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 diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index b6b6dbea..2cf8a3e8 100644 --- a/src/vfile_kind.ml +++ b/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 diff --git a/src/vfile_kind.mli b/src/vfile_kind.mli index 447b910d..c4351ff5 100644 --- a/src/vfile_kind.mli +++ b/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