Get rid of value files

This simplifies a lot of the code. The last use of values file was for storing package version, but the win was so negligivle that it is not worth keeping all this complexity. Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
ocaml · Apr 17, 2019 · 745d4e7 · 745d4e7
1 parent 51b0e5f
commit 745d4e7
Show file tree

Hide file tree

Showing 13 changed files with 102 additions and 316 deletions.
diff --git a/src/build.ml b/src/build.ml
@@ -1,15 +1,10 @@
 open! Stdune
 open Import
 
-module Vspec = struct
-  type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
-end
-
 module Repr = struct
   type ('a, 'b) t =
     | Arr : ('a -> 'b) -> ('a, 'b) t
-    | Targets : Path.t list -> ('a, 'a) t
-    | Store_vfile : 'a Vspec.t -> ('a, Action.t) t
+    | Targets : Path.Set.t -> ('a, 'a) t
     | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
     | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
     | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
@@ -21,7 +16,6 @@ module Repr = struct
     | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
     | Lines_of : Path.t -> ('a, string list) t
-    | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t
     | Dyn_deps : ('a, Dep.Set.t) t -> ('a, 'a) t
     | Record_lib_deps : Lib_deps_info.t -> ('a, 'a) t
@@ -116,7 +110,6 @@ let path p = Deps (Dep.Set.singleton (Dep.file p))
 let paths ps = Deps (Dep.Set.of_files ps)
 let path_set ps = Deps (Dep.Set.of_files_set ps)
 let paths_matching ~loc:_ dir_glob = Paths_glob dir_glob
-let vpath vp = Vpath vp
 let dyn_paths t = Dyn_paths (t >>^ Path.Set.of_list)
 let dyn_path_set t = Dyn_paths t
 let dyn_deps t = Dyn_deps t
@@ -167,7 +160,7 @@ let paths_existing paths =
 let fail ?targets x =
   match targets with
   | None -> Fail x
-  | Some l -> Targets l >>> Fail x
+  | Some l -> Targets (Path.Set.of_list l) >>> Fail x
 
 let of_result ?targets = function
   | Ok    x -> x
@@ -190,8 +183,6 @@ let source_tree ~dir ~file_tree =
   let paths = File_tree.files_recursively_in file_tree dir ~prefix_with in
   path_set paths >>^ fun _ -> paths
 
-let store_vfile spec = Store_vfile spec
-
 let get_prog = function
   | Ok p -> path p >>> arr (fun _ -> Ok p)
   | Error f ->
@@ -213,7 +204,7 @@ let run ~dir ?stdout_to prog args =
   let targets = Arg_spec.add_targets args (Option.to_list stdout_to) in
   prog_and_args ~dir prog args
   >>>
-  Targets targets
+  Targets (Path.Set.of_list targets)
   >>^ (fun (prog, args) ->
     let action : Action.t = Run (prog, args) in
     let action =
@@ -224,25 +215,25 @@ let run ~dir ?stdout_to prog args =
     Action.Chdir (dir, action))
 
 let action ?dir ~targets action =
-  Targets targets
+  Targets (Path.Set.of_list targets)
   >>^ fun _ ->
   match dir with
   | None -> action
   | Some dir -> Action.Chdir (dir, action)
 
 let action_dyn ?dir ~targets () =
   match dir with
-  | None -> Targets targets
+  | None -> Targets (Path.Set.of_list targets)
   | Some dir ->
-    Targets targets
+    Targets (Path.Set.of_list targets)
     >>^ fun action ->
     Action.Chdir (dir, action)
 
 let write_file fn s =
   action ~targets:[fn] (Write_file (fn, s))
 
 let write_file_dyn fn =
-  Targets [fn]
+  Targets (Path.Set.singleton fn)
   >>^ fun s ->
   Action.Write_file (fn, s)
 

diff --git a/src/build.mli b/src/build.mli
@@ -9,12 +9,6 @@ val arr : ('a -> 'b) -> ('a, 'b) t
 
 val return : 'a -> (unit, 'a) t
 
-module Vspec : sig
-  type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
-end
-
-val store_vfile : 'a Vspec.t -> ('a, Action.t) t
-
 module O : sig
   val ( >>> ) : ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
   val ( ^>> ) : ('a -> 'b) -> ('b, 'c) t -> ('a, 'c) t
@@ -90,8 +84,6 @@ val source_tree
 val dyn_paths : ('a, Path.t list) t -> ('a, 'a) t
 val dyn_path_set : ('a, Path.Set.t) t -> ('a, 'a) t
 
-val vpath : 'a Vspec.t  -> (unit, 'a) t
-
 (** [catch t ~on_error] evaluates to [on_error exn] if exception [exn] is
     raised during the evaluation of [t]. *)
 val catch : ('a, 'b) t -> on_error:(exn -> 'b) -> ('a, 'b) t
@@ -189,8 +181,7 @@ val record_lib_deps : Lib_deps_info.t -> ('a, 'a) t
 module Repr : sig
   type ('a, 'b) t =
     | Arr : ('a -> 'b) -> ('a, 'b) t
-    | Targets : Path.t list -> ('a, 'a) t
-    | Store_vfile : 'a Vspec.t -> ('a, Action.t) t
+    | Targets : Path.Set.t -> ('a, 'a) t
     | Compose : ('a, 'b) t * ('b, 'c) t -> ('a, 'c) t
     | First : ('a, 'b) t -> ('a * 'c, 'b * 'c) t
     | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
@@ -201,7 +192,6 @@ module Repr : sig
     | If_file_exists : Path.t * ('a, 'b) if_file_exists_state ref -> ('a, 'b) t
     | Contents : Path.t -> ('a, string) t
     | Lines_of : Path.t -> ('a, string list) t
-    | Vpath : 'a Vspec.t -> (unit, 'a) t
     | Dyn_paths : ('a, Path.Set.t) t -> ('a, 'a) t
     | Dyn_deps : ('a, Dep.Set.t) t -> ('a, 'a) t
     | Record_lib_deps : Lib_deps_info.t -> ('a, 'a) t

diff --git a/src/build_interpret.ml b/src/build_interpret.ml
@@ -2,22 +2,6 @@ open! Stdune
 open Import
 open Build.Repr
 
-module Vspec = Build.Vspec
-
-module Target = struct
-  type t =
-    | Normal of Path.t
-    | Vfile : _ Vspec.t -> t
-
-  let path = function
-    | Normal p -> p
-    | Vfile (Vspec.T (p, _)) -> p
-
-  let paths ts =
-    List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
-      Path.Set.add acc (path t))
-end
-
 let no_targets_allowed () =
   Exn.code_error "No targets allowed under a [Build.lazy_no_targets] \
                   or [Build.if_file_exists]" []
@@ -29,7 +13,6 @@ let static_deps t ~all_targets =
     match t with
     | Arr _ -> acc
     | Targets _ -> if not targets_allowed then no_targets_allowed (); acc
-    | Store_vfile _ -> if not targets_allowed then no_targets_allowed (); acc
     | Compose (a, b) -> loop a (loop b acc targets_allowed) targets_allowed
     | First t -> loop t acc targets_allowed
     | Second t -> loop t acc targets_allowed
@@ -57,8 +40,6 @@ let static_deps t ~all_targets =
       end
     | Dyn_paths t -> loop t acc targets_allowed
     | Dyn_deps t -> loop t acc targets_allowed
-    | Vpath (Vspec.T (p, _)) ->
-      Static_deps.add_rule_path acc p
     | Contents p -> Static_deps.add_rule_path acc p
     | Lines_of p -> Static_deps.add_rule_path acc p
     | Record_lib_deps _ -> acc
@@ -75,14 +56,12 @@ let lib_deps =
       match t with
       | Arr _ -> acc
       | Targets _ -> acc
-      | Store_vfile _ -> acc
       | Compose (a, b) -> loop a (loop b acc)
       | First t -> loop t acc
       | Second t -> loop t acc
       | Split (a, b) -> loop a (loop b acc)
       | Fanout (a, b) -> loop a (loop b acc)
       | Paths_for_rule _ -> acc
-      | Vpath _ -> acc
       | Paths_glob _ -> acc
       | Deps _ -> acc
       | Dyn_paths t -> loop t acc
@@ -100,19 +79,16 @@ let lib_deps =
   fun t -> loop (Build.repr t) Lib_name.Map.empty
 
 let targets =
-  let rec loop : type a b. (a, b) t -> Target.t list -> Target.t list = fun t acc ->
+  let rec loop : type a b. (a, b) t -> Path.Set.t -> Path.Set.t = fun t acc ->
     match t with
     | Arr _ -> acc
-    | Targets targets ->
-      List.fold_left targets ~init:acc ~f:(fun acc fn -> Target.Normal fn :: acc)
-    | Store_vfile spec -> Vfile spec :: acc
+    | Targets targets -> Path.Set.union targets acc
     | Compose (a, b) -> loop a (loop b acc)
     | First t -> loop t acc
     | Second t -> loop t acc
     | Split (a, b) -> loop a (loop b acc)
     | Fanout (a, b) -> loop a (loop b acc)
     | Paths_for_rule _ -> acc
-    | Vpath _ -> acc
     | Paths_glob _ -> acc
     | Deps _ -> acc
     | Dyn_paths t -> loop t acc
@@ -127,28 +103,30 @@ let targets =
           Exn.code_error "Build_interpret.targets got decided if_file_exists"
             ["exists", Sexp.Encoder.bool v]
         | Undecided (a, b) ->
-          match loop a [], loop b [] with
-          | [], [] -> acc
-          | a, b ->
-            let targets x = Path.Set.to_sexp (Target.paths x) in
+          let a = loop a Path.Set.empty in
+          let b = loop b Path.Set.empty in
+          if Path.Set.is_empty a && Path.Set.is_empty b then
+            acc
+          else begin
             Exn.code_error "Build_interpret.targets: cannot have targets \
                             under a [if_file_exists]"
-              [ "targets-a", targets a
-              ; "targets-b", targets b
+              [ "targets-a", Path.Set.to_sexp a
+              ; "targets-b", Path.Set.to_sexp b
               ]
+          end
       end
     | Memo m -> loop m.t acc
     | Catch (t, _) -> loop t acc
     | Lazy_no_targets _ -> acc
   in
-  fun t -> loop (Build.repr t) []
+  fun t -> loop (Build.repr t) Path.Set.empty
 
 module Rule = struct
   type t =
     { context  : Context.t option
     ; env      : Env.t option
     ; build    : (unit, Action.t) Build.t
-    ; targets  : Target.t list
+    ; targets  : Path.Set.t
     ; sandbox  : bool
     ; mode     : Dune_file.Rule.Mode.t
     ; locks    : Path.t list
@@ -160,30 +138,29 @@ module Rule = struct
         ~context ~env ?(locks=[]) ?loc build =
     let targets = targets build in
     let dir =
-      match targets with
-      | [] ->
-        begin match loc with
-        | Some loc -> Errors.fail loc "Rule has no targets specified"
-        | None -> Exn.code_error "Build_interpret.Rule.make: no targets" []
+      match Path.Set.choose targets with
+      | None -> begin
+          match loc with
+          | Some loc -> Errors.fail loc "Rule has no targets specified"
+          | None -> Exn.code_error "Build_interpret.Rule.make: no targets" []
         end
-      | x :: l ->
-        let dir = Path.parent_exn (Target.path x) in
-        List.iter l ~f:(fun target ->
-          let path = Target.path target in
-          if Path.parent_exn path <> dir then
-            match loc with
-            | None ->
-              Exn.code_error "rule has targets in different directories"
-                [ "targets", Sexp.Encoder.list Path.to_sexp
-                               (List.map targets ~f:Target.path)
-                ]
-            | Some loc ->
-              Errors.fail loc
-                "Rule has targets in different directories.\nTargets:\n%s"
-                (String.concat ~sep:"\n"
-                   (List.map targets ~f:(fun t ->
-                      sprintf "- %s"
-                        (Target.path t |> Path.to_string_maybe_quoted)))));
+      | Some x ->
+        let dir = Path.parent_exn x in
+        if Path.Set.exists targets ~f:(fun path -> Path.parent_exn path <> dir)
+        then begin
+          match loc with
+          | None ->
+            Exn.code_error "rule has targets in different directories"
+              [ "targets", Path.Set.to_sexp targets
+              ]
+          | Some loc ->
+            Errors.fail loc
+              "Rule has targets in different directories.\nTargets:\n%s"
+              (String.concat ~sep:"\n"
+                 (Path.Set.to_list targets |> List.map ~f:(fun p ->
+                    sprintf "- %s"
+                      (Path.to_string_maybe_quoted p))))
+        end;
         dir
     in
     { context

diff --git a/src/build_interpret.mli b/src/build_interpret.mli
@@ -1,21 +1,12 @@
 open! Stdune
 open! Import
 
-module Target : sig
-  type t =
-    | Normal of Path.t
-    | Vfile : _ Build.Vspec.t -> t
-
-  val path : t -> Path.t
-  val paths : t list -> Path.Set.t
-end
-
 module Rule : sig
   type t =
     { context  : Context.t option
     ; env      : Env.t option
     ; build    : (unit, Action.t) Build.t
-    ; targets  : Target.t list
+    ; targets  : Path.Set.t
     ; sandbox  : bool
     ; mode     : Dune_file.Rule.Mode.t
     ; locks    : Path.t list
@@ -48,4 +39,4 @@ val lib_deps
 
 val targets
   :  (_, _) Build.t
-  -> Target.t list
+  -> Path.Set.t