From 2a80d034fac3313d75676edc211b1be63266e430 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 15:06:35 +0630 Subject: [PATCH 1/8] Use Util.Persistent to reimplemented promoted files store Signed-off-by: Rudi Grinberg --- src/build_system.ml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index 80c8f56f..6950811d 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -10,6 +10,11 @@ let alias_dir = Path.(relative build_dir) ".aliases" let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct + module P = Utils.Persistent(struct + type t = Path.t list + let name = "PROMOTED-TO-DELETE" + let version = 1 + end) let db = ref [] let fn = Path.relative Path.build_dir ".to-delete-in-source-tree" @@ -17,19 +22,15 @@ module Promoted_to_delete = struct let add p = db := p :: !db 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:[] (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.of_list + |> Path.Set.union (Path.Set.of_list !db) + |> Path.Set.to_list + |> P.dump fn end let files_in_source_tree_to_delete () = From 4738b6df899ba5b61259b9485efbc2d4404ee561 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 15:10:35 +0630 Subject: [PATCH 2/8] Make promoted files a set Signed-off-by: Rudi Grinberg --- bin/main.ml | 2 +- src/build_system.ml | 13 ++++++------- src/build_system.mli | 4 ++-- 3 files changed, 9 insertions(+), 10 deletions(-) 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/build_system.ml b/src/build_system.ml index 6950811d..edceb4c2 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -11,25 +11,24 @@ let misc_dir = Path.(relative build_dir) ".misc" module Promoted_to_delete = struct module P = Utils.Persistent(struct - type t = Path.t list + type t = Path.Set.t let name = "PROMOTED-TO-DELETE" let version = 1 end) - let db = ref [] + + 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 () = - Option.value ~default:[] (P.load fn) + Option.value ~default:Path.Set.empty (P.load fn) let dump () = if Path.build_dir_exists () then load () - |> Path.Set.of_list - |> Path.Set.union (Path.Set.of_list !db) - |> Path.Set.to_list + |> Path.Set.union !db |> P.dump fn end 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} *) From bc09b8fc81b75719f27fcdbd85c5ff11a0b9bb67 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 15:31:48 +0630 Subject: [PATCH 3/8] Change Action.Promotion to use Utils.Persistent Signed-off-by: Rudi Grinberg --- src/action.ml | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) 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 } -> From aa22671b2fc62cf569a9a0f6c0660b1bada628db Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 16:35:13 +0630 Subject: [PATCH 4/8] Remove Make_full from file_kind signature since it's unused Signed-off-by: Rudi Grinberg --- src/vfile_kind.mli | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/vfile_kind.mli b/src/vfile_kind.mli index 447b910d..5503cc30 100644 --- a/src/vfile_kind.mli +++ b/src/vfile_kind.mli @@ -23,9 +23,3 @@ 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) - : S with type t = T.t From 2071ac107274886b07d24688f1d7eab76e75c411 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 18:01:06 +0630 Subject: [PATCH 5/8] Implement Vfile_kind in term of Persistent Signed-off-by: Rudi Grinberg --- src/build_system.ml | 4 ++-- src/super_context.ml | 4 ++-- src/utils.ml | 3 +++ src/utils.mli | 1 + src/vfile_kind.ml | 39 ++++++++++++++------------------------- src/vfile_kind.mli | 4 ++-- 6 files changed, 24 insertions(+), 31 deletions(-) diff --git a/src/build_system.ml b/src/build_system.ml index edceb4c2..16e655fb 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -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/super_context.ml b/src/super_context.ml index 5f883bbe..8d1b2c9f 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -535,8 +535,8 @@ 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 + (struct + let t = Sexp.To_sexp.(option string) end) let spec sctx (p : Package.t) = diff --git a/src/utils.ml b/src/utils.ml index c8fb0a8b..bf2549e0 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) = + 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..90911ca0 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,26 @@ let eq (type a) (type b) (module B : S with type t = b) = Id.eq A.id B.id -module Make_full +module Make (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) + (To_sexp : sig val t : T.t Sexp.To_sexp.t end) : S with type t = T.t = struct type t = T.t + (* XXX dune dump should make use of this *) + let _t = To_sexp.t + + module P = Utils.Persistent(struct + type nonrec t = t + let name = "VFILE_KIND" + 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 5503cc30..be540065 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) @@ -21,5 +21,5 @@ 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) + (To_sexp : sig val t : T.t Sexp.To_sexp.t end) : S with type t = T.t From 31774047411d7c2c740c13bfa6df30cabd13cecd Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 18:02:50 +0630 Subject: [PATCH 6/8] Remove extra module from Vfile_kind functor Signed-off-by: Rudi Grinberg --- src/super_context.ml | 8 ++++---- src/vfile_kind.ml | 8 +++++--- src/vfile_kind.mli | 6 ++++-- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/super_context.ml b/src/super_context.ml index 8d1b2c9f..964f895d 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -534,10 +534,10 @@ end module Pkg_version = struct open Build.O - module V = Vfile_kind.Make(struct type t = string option end) - (struct - let t = Sexp.To_sexp.(option string) - end) + module V = Vfile_kind.Make(struct + type t = string option + let t = Sexp.To_sexp.(option string) + end) let spec sctx (p : Package.t) = let fn = diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index 90911ca0..dceff38d 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -43,14 +43,16 @@ let eq (type a) (type b) Id.eq A.id B.id module Make - (T : sig type t end) - (To_sexp : sig val t : T.t Sexp.To_sexp.t end) + (T : sig + type t + val t : t Sexp.To_sexp.t + end) : S with type t = T.t = struct type t = T.t (* XXX dune dump should make use of this *) - let _t = To_sexp.t + let _t = T.t module P = Utils.Persistent(struct type nonrec t = t diff --git a/src/vfile_kind.mli b/src/vfile_kind.mli index be540065..3ae1c604 100644 --- a/src/vfile_kind.mli +++ b/src/vfile_kind.mli @@ -20,6 +20,8 @@ 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) - (To_sexp : sig val t : T.t Sexp.To_sexp.t end) + (T : sig + type t + val t : t Sexp.To_sexp.t + end) : S with type t = T.t From ef5a2144dddbcd9510d0832dd2676d7cc1c52c6f Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 22:40:00 +0630 Subject: [PATCH 7/8] Add magic to to_out_string Signed-off-by: Rudi Grinberg --- src/utils.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils.ml b/src/utils.ml index bf2549e0..2c9f22d6 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -156,7 +156,7 @@ module Persistent(D : Persistent_desc) = struct let magic = sprintf "DUNE-%sv%d:" D.name D.version let to_out_string (v : D.t) = - Marshal.to_string v [] + magic ^ Marshal.to_string v [] let dump file (v : D.t) = Io.with_file_out file ~f:(fun oc -> From 79224ff1942c1da00f1fa030e67ed81b4331eeed Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Thu, 28 Jun 2018 22:42:55 +0630 Subject: [PATCH 8/8] Add name to Vfile_kind functor Signed-off-by: Rudi Grinberg --- src/super_context.ml | 1 + src/vfile_kind.ml | 3 ++- src/vfile_kind.mli | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/super_context.ml b/src/super_context.ml index 964f895d..fab6f655 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -537,6 +537,7 @@ module Pkg_version = struct 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) = diff --git a/src/vfile_kind.ml b/src/vfile_kind.ml index dceff38d..2cf8a3e8 100644 --- a/src/vfile_kind.ml +++ b/src/vfile_kind.ml @@ -46,6 +46,7 @@ module Make (T : sig type t val t : t Sexp.To_sexp.t + val name : string end) : S with type t = T.t = struct @@ -56,7 +57,7 @@ struct module P = Utils.Persistent(struct type nonrec t = t - let name = "VFILE_KIND" + let name = "VFILE_KIND-" ^ T.name let version = 1 end) diff --git a/src/vfile_kind.mli b/src/vfile_kind.mli index 3ae1c604..c4351ff5 100644 --- a/src/vfile_kind.mli +++ b/src/vfile_kind.mli @@ -23,5 +23,6 @@ module Make (T : sig type t val t : t Sexp.To_sexp.t + val name : string end) : S with type t = T.t