diff --git a/src/action.ml b/src/action.ml index f274750b..ec2aeeb9 100644 --- a/src/action.ml +++ b/src/action.ml @@ -29,6 +29,29 @@ let expand_path ~dir ~f template = |> String.concat ~sep:" " |> Path.relative dir +let expand_prog ctx ~dir ~f template = + let resolve s = + if String.contains s '/' then + Path.relative dir s + else + match Context.which ctx s with + | Some p -> p + | None -> + die "@{Error@}: Program %s not found in PATH (context: %s)" s ctx.name + in + match String_with_vars.just_a_var template with + | None -> resolve (expand_str ~dir ~f template) + | Some v -> + match f v with + | Not_found -> resolve (expand_str ~dir ~f template) + | Path p + | Paths [p] -> p + | Str s -> resolve s + | Paths l -> + List.map l ~f:(Path.reach ~from:dir) + |> String.concat ~sep:" " + |> resolve + module Mini_shexp = struct module Ast = struct type ('a, 'path) t = @@ -126,20 +149,20 @@ module Mini_shexp = struct Ast.fold t ~init ~f:(fun acc pat -> String_with_vars.fold ~init:acc pat ~f) - let rec expand dir t ~f : (string, Path.t) Ast.t = + let rec expand ctx dir t ~f : (string, Path.t) Ast.t = match t with | Run (prog, args) -> - Run (expand_path ~dir ~f prog, + Run (expand_prog ctx ~dir ~f prog, List.map args ~f:(fun arg -> expand_str ~dir ~f arg)) | Chdir (fn, t) -> let fn = expand_path ~dir ~f fn in - Chdir (fn, expand fn t ~f) + Chdir (fn, expand ctx fn t ~f) | Setenv (var, value, t) -> Setenv (expand_str ~dir ~f var, expand_str ~dir ~f value, - expand dir t ~f) + expand ctx dir t ~f) | With_stdout_to (fn, t) -> - With_stdout_to (expand_path ~dir ~f fn, expand dir t ~f) - | Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f)) + With_stdout_to (expand_path ~dir ~f fn, expand ctx dir t ~f) + | Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f)) | Echo x -> Echo (expand_str ~dir ~f x) | Cat x -> Cat (expand_path ~dir ~f x) | Create_file x -> Create_file (expand_path ~dir ~f x) diff --git a/src/action.mli b/src/action.mli index 9184a422..4a1fe10e 100644 --- a/src/action.mli +++ b/src/action.mli @@ -37,7 +37,7 @@ module Mini_shexp : sig val t : t Sexp.Of_sexp.t val sexp_of_t : t Sexp.To_sexp.t val fold_vars : t -> init:'a -> f:('a -> string -> 'a) -> 'a - val expand : Path.t -> t -> f:(string -> var_expansion) -> desc + val expand : Context.t -> Path.t -> t -> f:(string -> var_expansion) -> desc end with type desc := t end diff --git a/src/build.ml b/src/build.ml index 7c6d2054..1a6b1500 100644 --- a/src/build.ml +++ b/src/build.ml @@ -34,7 +34,7 @@ module Repr = struct | Vpath : 'a Vspec.t -> (unit, 'a) t | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t - | Fail : fail -> ('a, 'a) t + | Fail : fail -> (_, _) t end include Repr let repr t = t diff --git a/src/build.mli b/src/build.mli index 2d5976a8..c5009947 100644 --- a/src/build.mli +++ b/src/build.mli @@ -47,7 +47,7 @@ val lines_of : Path.t -> ('a, string list) t (** Always fail when executed. We pass a function rather than an exception to get a proper backtrace *) -val fail : fail -> ('a, 'a) t +val fail : fail -> (_, _) t module Prog_spec : sig type 'a t = @@ -116,7 +116,7 @@ module Repr : sig | Vpath : 'a Vspec.t -> (unit, 'a) t | Dyn_paths : ('a, Path.t list) t -> ('a, 'a) t | Record_lib_deps : Path.t * lib_deps -> ('a, 'a) t - | Fail : fail -> ('a, 'a) t + | Fail : fail -> (_, _) t end val repr : ('a, 'b) t -> ('a, 'b) Repr.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 99426c3e..6a04fa9d 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1483,18 +1483,24 @@ module Gen(P : Params) = struct ~f:(Path.relative dir)) in let forms = extract_artifacts ~dir t in - let t = - U.expand dir t - ~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps) + let build = + match + U.expand ctx dir t + ~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps) + with + | t -> + Build.paths (String_map.values forms.artifacts) + >>> + Build.action t ~dir ~targets + | exception e -> + Build.fail { fail = fun () -> raise e } in let build = Build.record_lib_deps ~dir ~kind:dep_kind (String_set.elements forms.lib_deps |> List.map ~f:(fun s -> Lib_dep.Direct s)) >>> - Build.paths (String_map.values forms.artifacts) - >>> - Build.action t ~dir ~targets + build in match forms.failures with | [] -> build