diff --git a/src/build.ml b/src/build.ml index 36b53fb8..c1e49f5d 100644 --- a/src/build.ml +++ b/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 -> diff --git a/src/build.mli b/src/build.mli index 41877426..c309eaed 100644 --- a/src/build.mli +++ b/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. *) diff --git a/src/gen_rules.ml b/src/gen_rules.ml index b418e279..0dc4a165 100644 --- a/src/gen_rules.ml +++ b/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 diff --git a/src/string_with_vars.ml b/src/string_with_vars.ml index c27f4e61..83b12924 100644 --- a/src/string_with_vars.ml +++ b/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 diff --git a/src/string_with_vars.mli b/src/string_with_vars.mli index bff93f67..54536141 100644 --- a/src/string_with_vars.mli +++ b/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 diff --git a/src/user_action.ml b/src/user_action.ml index 3b2b231e..9aa35826 100644 --- a/src/user_action.ml +++ b/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