simplify

src/build.ml

@@ -177,30 +177,23 @@ module Shexp = struct
     let env = Context.extend_env ~vars:env_extra ~env in
     Future.run Strict ~dir:(Path.to_string dir) ~env ~stdout_to prog args
 
-  let rec exec t ~dir ~env ~env_extra ~stdout_to ~tail ~f =
+  let rec exec t ~dir ~env ~env_extra ~stdout_to ~tail =
     match t with
     | Run (prog, args) ->
-      let prog = f ~dir prog in
-      let args = List.map args ~f:(f ~dir) in
       run ~dir ~env ~env_extra ~stdout_to ~tail prog args
     | Chdir (fn, t) ->
-      let fn = f ~dir fn in
-      exec t ~env ~env_extra ~stdout_to ~tail ~dir:(Path.relative dir fn) ~f
+      exec t ~env ~env_extra ~stdout_to ~tail ~dir:(Path.relative dir fn)
     | Setenv (var, value, t) ->
-      let var = f ~dir var in
-      let value = f ~dir value in
-      exec t ~dir ~env ~stdout_to ~tail ~f
+      exec t ~dir ~env ~stdout_to ~tail
         ~env_extra:(String_map.add env_extra ~key:var ~data:value)
     | With_stdout_to (fn, t) ->
-      let fn = f ~dir fn in
       if tail then Option.iter stdout_to ~f:(fun (_, oc) -> close_out oc);
       let fn = Path.to_string (Path.relative dir fn) in
-      exec t ~dir ~env ~env_extra ~tail ~f
+      exec t ~dir ~env ~env_extra ~tail
         ~stdout_to:(Some (fn, open_out_bin fn))
     | Progn l ->
-      exec_list l ~dir ~env ~env_extra ~stdout_to ~tail ~f
+      exec_list l ~dir ~env ~env_extra ~stdout_to ~tail
     | Echo str ->
-      let str = f ~dir str in
       return
         (match stdout_to with
          | None -> print_string str; flush stdout
@@ -208,7 +201,6 @@ module Shexp = struct
            output_string oc str;
            if tail then close_out oc)
     | Cat fn ->
-      let fn = f ~dir fn in
       let fn = Path.to_string (Path.relative dir fn) in
       with_file_in fn ~f:(fun ic ->
         match stdout_to with
@@ -218,8 +210,8 @@ module Shexp = struct
           if tail then close_out oc);
       return ()
     | Copy_and_add_line_directive (src, dst) ->
-      let src = Path.relative dir (f ~dir src) in
-      let dst = Path.relative dir (f ~dir dst) in
+      let src = Path.relative dir src in
+      let dst = Path.relative dir dst in
       with_file_in (Path.to_string src) ~f:(fun ic ->
         with_file_out (Path.to_string dst) ~f:(fun oc ->
           let fn =
@@ -231,7 +223,6 @@ module Shexp = struct
           copy_channels ic oc));
       return ()
     | System cmd ->
-      let cmd = f ~dir cmd in
       let path, arg, err =
         Utils.system_shell ~needed_to:"interpret (system ...) actions"
       in
@@ -241,29 +232,29 @@ module Shexp = struct
         run ~dir ~env ~env_extra ~stdout_to ~tail
           (Path.to_string path) [arg; cmd]
 
-  and exec_list l ~dir ~env ~env_extra ~stdout_to ~tail ~f =
+  and exec_list l ~dir ~env ~env_extra ~stdout_to ~tail =
     match l with
     | [] ->
       if tail then Option.iter stdout_to ~f:(fun (_, oc) -> close_out oc);
       Future.return ()
     | [t] ->
-      exec t ~dir ~env ~env_extra ~stdout_to ~tail ~f
+      exec t ~dir ~env ~env_extra ~stdout_to ~tail
     | t :: rest ->
-      exec t ~dir ~env ~env_extra ~stdout_to ~tail:false ~f >>= fun () ->
-      exec_list rest ~dir ~env ~env_extra ~stdout_to ~tail ~f
+      exec t ~dir ~env ~env_extra ~stdout_to ~tail:false >>= fun () ->
+      exec_list rest ~dir ~env ~env_extra ~stdout_to ~tail
 
-  let exec t ~dir ~env ~f =
-    exec t ~dir ~env ~env_extra:String_map.empty ~stdout_to:None ~tail:true ~f
+  let exec t ~dir ~env =
+    exec t ~dir ~env ~env_extra:String_map.empty ~stdout_to:None ~tail:true
 end
 
-let user_action action ~dir ~env ~targets ~expand:f =
+let user_action action ~dir ~env ~targets =
   prim ~targets (fun () ->
     match (action : _ User_action.t) with
     | Bash cmd ->
       Future.run Strict ~dir:(Path.to_string dir) ~env
-        "/bin/bash" ["-e"; "-u"; "-o"; "pipefail"; "-c"; f ~dir cmd]
+        "/bin/bash" ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
     | Shexp shexp ->
-      Shexp.exec ~dir ~env ~f shexp)
+      Shexp.exec ~dir ~env shexp)
 
 let echo fn =
   create_file ~target:fn (fun data ->

src/build.mli

@@ -65,11 +65,10 @@ val run
   -> ('a, unit) t
 
 val user_action
-  :  'a User_action.t
+  :  string User_action.t
   -> dir:Path.t
   -> env:string array
   -> targets:Path.t list
-  -> expand:(dir:Path.t -> 'a -> string)
   -> (unit, unit) t
 
 (** Create a file with the given contents. *)

src/gen_rules.ml

@@ -1354,12 +1354,12 @@ module Gen(P : Params) = struct
           add_artifact acc ~var ~lib_dep res
         | _ -> acc)
 
-    let expand_string_with_vars ~artifacts ~targets ~deps =
+    let expand_string_with_vars =
       let dep_exn ~dir name = function
         | Some dep -> Path.reach ~from:dir dep
         | None -> die "cannot use ${%s} with files_recursively_in" name
       in
-      let lookup ~dir var_name =
+      fun  ~artifacts ~targets ~deps dir var_name ->
         match String_map.find var_name artifacts with
         | Some path -> Some (Path.reach ~from:dir path)
         | None ->
@@ -1371,9 +1371,6 @@ module Gen(P : Params) = struct
             let deps = List.map deps ~f:(dep_exn ~dir var_name) in
             Some (String.concat ~sep:" " deps)
           | _ -> root_var_lookup ~dir var_name
-      in
-      fun ~dir str ->
-        String_with_vars.expand str ~f:(lookup ~dir)
 
     let run t ~dir ~dep_kind ~targets ~deps =
       let deps =
@@ -1382,6 +1379,10 @@ module Gen(P : Params) = struct
             ~f:(Path.relative dir))
       in
       let forms = extract_artifacts ~dir t in
+      let t =
+        User_action.Unexpanded.expand dir t
+          ~f:(expand_string_with_vars ~artifacts:forms.artifacts ~targets ~deps)
+      in
       let build =
         Build.record_lib_deps ~dir ~kind:dep_kind
           (String_set.elements forms.lib_deps
@@ -1390,7 +1391,6 @@ module Gen(P : Params) = struct
         Build.paths (String_map.values forms.artifacts)
         >>>
         Build.user_action t ~dir ~env:ctx.env ~targets
-          ~expand:(expand_string_with_vars ~artifacts:forms.artifacts ~targets ~deps)
       in
       match forms.failures with
       | [] -> build

src/string_with_vars.ml

@@ -89,12 +89,25 @@ let expand t ~f =
         | Braces -> sprintf "${%s}" v)
   |> String.concat ~sep:""
 
+let expand_with_context context t ~f =
+  List.map t ~f:(function
+    | Text s -> s
+    | Var (syntax, v) ->
+      match f context v with
+      | Some x -> x
+      | None ->
+        match syntax with
+        | Parens -> sprintf "$(%s)" v
+        | Braces -> sprintf "${%s}" v)
+  |> String.concat ~sep:""
+
 module type Container = sig
   type 'a t
   val t : 'a Sexp.Of_sexp.t -> 'a t Sexp.Of_sexp.t
   val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t
 
-  val map : 'a t -> f:('a -> 'b) -> 'b t
+  type context
+  val expand : context -> 'a t -> f:(context -> 'a -> string) -> string t
   val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
 end
 
@@ -107,6 +120,7 @@ module Lift(M : Container) = struct
   let fold t ~init ~f =
     M.fold t ~init ~f:(fun acc x -> fold x ~init:acc ~f)
 
-  let expand t ~f = M.map t ~f:(expand ~f)
+  let expand context (t : t) ~f =
+    M.expand context t ~f:(expand_with_context ~f)
 end
 

src/string_with_vars.mli

@@ -22,7 +22,8 @@ module type Container = sig
   val t : 'a Sexp.Of_sexp.t -> 'a t Sexp.Of_sexp.t
   val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t
 
-  val map : 'a t -> f:('a -> 'b) -> 'b t
+  type context
+  val expand : context -> 'a t -> f:(context -> 'a -> string) -> string t
   val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b
 end
 
@@ -34,5 +35,9 @@ module Lift(M : Container) : sig
 
   val fold : t -> init:'a -> f:('a -> string -> 'a) -> 'a
 
-  val expand : t -> f:(string -> string option) -> string M.t
+  val expand
+    :  M.context
+    -> t
+    -> f:(M.context -> string -> string option)
+    -> string M.t
 end

src/user_action.ml

@@ -30,17 +30,24 @@ module Mini_shexp = struct
       ]
       sexp
 
-  let rec map t ~f =
+  let rec expand dir t ~f =
     match t with
-    | Run (prog, args) -> Run (f prog, List.map args ~f)
-    | Chdir (fn, t) -> Chdir (f fn, map t ~f)
-    | Setenv (var, value, t) -> Setenv (f var, f value, map t ~f)
-    | With_stdout_to (fn, t) -> With_stdout_to (f fn, map t ~f)
-    | Progn l -> Progn (List.map l ~f:(map ~f))
-    | Echo x -> Echo (f x)
-    | Cat x -> Cat (f x)
-    | Copy_and_add_line_directive (x, y) -> Copy_and_add_line_directive (f x, f y)
-    | System x -> System (f x)
+    | Run (prog, args) ->
+      Run (f dir prog,
+           List.map args ~f:(fun arg -> f dir arg))
+    | Chdir (fn, t) ->
+      let fn = f dir fn in
+      Chdir (fn, expand (Path.relative dir fn) t ~f)
+    | Setenv (var, value, t) ->
+      Setenv (f dir var, f dir value, expand dir t ~f)
+    | With_stdout_to (fn, t) ->
+      With_stdout_to (f dir fn, expand dir t ~f)
+    | Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
+    | Echo x -> Echo (f dir x)
+    | Cat x -> Cat (f dir x)
+    | Copy_and_add_line_directive (x, y) ->
+      Copy_and_add_line_directive (f dir x, f dir y)
+    | System x -> System (f dir x)
 
   let rec fold t ~init:acc ~f =
     match t with
@@ -77,10 +84,12 @@ module T = struct
     | Atom _ -> Bash  (a              sexp)
     | List _ -> Shexp (Mini_shexp.t a sexp)
 
-  let map t ~f =
+  type context = Path.t
+
+  let expand dir t ~f =
     match t with
-    | Bash x -> Bash (f x)
-    | Shexp x -> Shexp (Mini_shexp.map x ~f)
+    | Bash x -> Bash (f dir x)
+    | Shexp x -> Shexp (Mini_shexp.expand dir x ~f)
 
   let fold t ~init ~f =
     match t with