diff --git a/CHANGES.md b/CHANGES.md index 90415ca3..0441ebd6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -50,6 +50,10 @@ - Automatically add the `.exe` when installing executables on Windows (#123) +- `(run ...)` now resolves `` locally if + possible. i.e. `(run ${bin:prog} ...)` and `(run prog ...)` behave + the same. This seems like the right default + - Fix a bug where `jbuild rules` would crash instead of reporting a proper build error diff --git a/doc/jbuild.rst b/doc/jbuild.rst index e9213f9f..183ed524 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -558,10 +558,13 @@ In addition, ``(action ...)`` fields support the following special variables: - ``path:`` expands to ```` - ``exe:`` is the same as ````, except when cross-compiling, in which case it will expand to ```` from the host build context -- ``bin:`` expands to a path to ``program``. If ``program`` is - installed by a package in the workspace (see `install`_ stanzas), the locally - built binary will be used, otherwise it will be searched in the ``PATH`` of - the current build context +- ``bin:`` expands to a path to ``program``. If ``program`` + is installed by a package in the workspace (see `install`_ stanzas), + the locally built binary will be used, otherwise it will be searched + in the ``PATH`` of the current build context. Note that ``(run + ${bin:program} ...)`` and ``(run program ...)`` behave in the same + way. ``${bin:...}`` is only necessary when you are using ``(bash + ...)`` or ``(system ...)`` - ``lib::`` expands to a path to file ```` of library ````. If ```` is available in the current workspace, the local file will be used, otherwise the one from @@ -896,7 +899,9 @@ configuration related tasks. The following constructions are available: -- ``(run )`` to execute a program +- ``(run )`` to execute a program. ```` is resolved + locally if it is available in the current workspace, otherwise it is + resolved using the ``PATH`` - ``(chdir )`` to change the current directory - ``(setenv )`` to set an environment variable - ``(with--to )`` to redirect the output to a file, where diff --git a/src/action.ml b/src/action.ml index 40240c8e..423bc1f9 100644 --- a/src/action.ml +++ b/src/action.ml @@ -3,94 +3,6 @@ open Sexp.Of_sexp module Env_var_map = Context.Env_var_map -module Program = struct - type t = - | This of Path.t - | Not_found of string - - let sexp_of_t = function - | This p -> Path.sexp_of_t p - | Not_found s -> List [Atom "not_found"; Atom s] - - let t sexp = - match sexp with - | Atom _ -> This (Path.t sexp) - | List (_, [Atom (_, "not_found"); Atom (_, s)]) -> Not_found s - | _ -> - Loc.fail (Sexp.Ast.loc sexp) - "S-expression of the form or (not_found ) expected" - - let resolve ctx ~dir s = - if s = "" then - Not_found "" - else if String.contains s '/' then - This (Path.relative dir s) - else - match Context.which ctx s with - | Some p -> This p - | None -> Not_found s -end - -module Var_expansion = struct - module Concat_or_split = struct - type t = - | Concat (* default *) - | Split (* ${!...} *) - end - - open Concat_or_split - - type t = - | Paths of Path.t list * Concat_or_split.t - | Strings of string list * Concat_or_split.t - - let concat = function - | [s] -> s - | l -> String.concat ~sep:" " l - - let string_of_path ~dir p = Path.reach ~from:dir p - let path_of_string ~dir s = Path.relative dir s - - let to_strings ~dir = function - | Strings (l, Split ) -> l - | Strings (l, Concat) -> [concat l] - | Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir) - | Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))] - - let to_string ~dir = function - | Strings (_, Split) | Paths (_, Split) -> assert false - | Strings (l, Concat) -> concat l - | Paths (l, Concat) -> concat (List.map l ~f:(string_of_path ~dir)) - - let to_path ~dir = function - | Strings (_, Split) | Paths (_, Split) -> assert false - | Strings (l, Concat) -> path_of_string ~dir (concat l) - | Paths ([p], Concat) -> p - | Paths (l, Concat) -> - path_of_string ~dir (concat (List.map l ~f:(string_of_path ~dir))) - - let to_prog_and_args ctx ~dir exp : Program.t * string list = - let resolve = Program.resolve in - match exp with - | Paths ([p], _) -> (This p, []) - | Strings ([s], _) -> (resolve ctx ~dir s, []) - | Paths ([], _) | Strings ([], _) -> (Not_found "", []) - | Paths (l, Concat) -> - (This - (path_of_string ~dir - (concat (List.map l ~f:(string_of_path ~dir)))), - []) - | Strings (l, Concat) -> - (resolve ~dir ctx (concat l), l) - | Paths (p :: l, Split) -> - (This p, List.map l ~f:(string_of_path ~dir)) - | Strings (s :: l, Split) -> - (resolve ~dir ctx s, l) -end - -module VE = Var_expansion -module SW = String_with_vars - module Outputs = struct include Action_intf.Outputs @@ -181,14 +93,47 @@ struct | Mkdir x -> List [Atom "mkdir"; path x] end +module Make_mapper + (Src : Action_intf.Ast) + (Dst : Action_intf.Ast) += struct + let rec map (t : Src.t) ~f_program ~f_string ~f_path : Dst.t = + match t with + | Run (prog, args) -> + Run (f_program prog, List.map args ~f:f_string) + | Chdir (fn, t) -> + Chdir (f_path fn, map t ~f_program ~f_string ~f_path) + | Setenv (var, value, t) -> + Setenv (f_string var, f_string value, map t ~f_program ~f_string ~f_path) + | Redirect (outputs, fn, t) -> + Redirect (outputs, f_path fn, map t ~f_program ~f_string ~f_path) + | Ignore (outputs, t) -> + Ignore (outputs, map t ~f_program ~f_string ~f_path) + | Progn l -> Progn (List.map l ~f:(fun t -> map t ~f_program ~f_string ~f_path)) + | Echo x -> Echo (f_string x) + | Cat x -> Cat (f_path x) + | Create_file x -> Create_file (f_path x) + | Copy (x, y) -> Copy (f_path x, f_path y) + | Symlink (x, y) -> + Symlink (f_path x, f_path y) + | Copy_and_add_line_directive (x, y) -> + Copy_and_add_line_directive (f_path x, f_path y) + | System x -> System (f_string x) + | Bash x -> Bash (f_string x) + | Update_file (x, y) -> Update_file (f_path x, f_string y) + | Rename (x, y) -> Rename (f_path x, f_path y) + | Remove_tree x -> Remove_tree (f_path x) + | Mkdir x -> Mkdir (f_path x) +end + module type Ast = Action_intf.Ast - with type program = Program.t + with type program = Path.t with type path = Path.t with type string = String.t module rec Ast : Ast = Ast include Make_ast - (Program) + (Path) (Path) (struct type t = string @@ -197,6 +142,95 @@ include Make_ast end) (Ast) +module Unresolved = struct + module Program = struct + type t = + | This of Path.t + | Search of string + + let of_string ~dir s = + if String.contains s '/' then + This (Path.relative dir s) + else + Search s + end + + module type Uast = Action_intf.Ast + with type program = Program.t + with type path = Path.t + with type string = String.t + module rec Uast : Uast = Uast + include Uast + + include Make_mapper(Uast)(Ast) + + let resolve t ~f = + map t ~f_path:(fun x -> x) ~f_string:(fun x -> x) + ~f_program:(function + | This p -> p + | Search s -> f s) +end + +module Var_expansion = struct + module Concat_or_split = struct + type t = + | Concat (* default *) + | Split (* ${!...} *) + end + + open Concat_or_split + + type t = + | Paths of Path.t list * Concat_or_split.t + | Strings of string list * Concat_or_split.t + + let concat = function + | [s] -> s + | l -> String.concat ~sep:" " l + + let string_of_path ~dir p = Path.reach ~from:dir p + let path_of_string ~dir s = Path.relative dir s + + let to_strings ~dir = function + | Strings (l, Split ) -> l + | Strings (l, Concat) -> [concat l] + | Paths (l, Split ) -> List.map l ~f:(string_of_path ~dir) + | Paths (l, Concat) -> [concat (List.map l ~f:(string_of_path ~dir))] + + let to_string ~dir = function + | Strings (_, Split) | Paths (_, Split) -> assert false + | Strings (l, Concat) -> concat l + | Paths (l, Concat) -> concat (List.map l ~f:(string_of_path ~dir)) + + let to_path ~dir = function + | Strings (_, Split) | Paths (_, Split) -> assert false + | Strings (l, Concat) -> path_of_string ~dir (concat l) + | Paths ([p], Concat) -> p + | Paths (l, Concat) -> + path_of_string ~dir (concat (List.map l ~f:(string_of_path ~dir))) + + let to_prog_and_args ~dir exp : Unresolved.Program.t * string list = + let module P = Unresolved.Program in + match exp with + | Paths ([p], _) -> (This p, []) + | Strings ([s], _) -> (P.of_string ~dir s, []) + | Paths ([], _) | Strings ([], _) -> (Search "", []) + | Paths (l, Concat) -> + (This + (path_of_string ~dir + (concat (List.map l ~f:(string_of_path ~dir)))), + []) + | Strings (l, Concat) -> + (P.of_string ~dir (concat l), l) + | Paths (p :: l, Split) -> + (This p, List.map l ~f:(string_of_path ~dir)) + | Strings (s :: l, Split) -> + (P.of_string ~dir s, l) +end + +module VE = Var_expansion +module SW = String_with_vars + module Unexpanded = struct module type Uast = Action_intf.Ast with type program = String_with_vars.t @@ -221,6 +255,8 @@ module Unexpanded = struct Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path]) module Partial = struct + module Program = Unresolved.Program + module type Past = Action_intf.Ast with type program = (Program.t, String_with_vars.t) either with type path = (Path.t , String_with_vars.t) either @@ -261,30 +297,30 @@ module Unexpanded = struct ~special:VE.to_path ~map:(fun x -> x) - let prog_and_args ctx ~dir ~f x = + let prog_and_args ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir:_ s -> (Program.resolve ctx ~dir s, [])) - ~special:(VE.to_prog_and_args ctx) + ~generic:(fun ~dir:_ s -> (Program.of_string ~dir s, [])) + ~special:VE.to_prog_and_args ~map:(fun x -> (x, [])) end - let rec expand ctx dir t ~f : Ast.t = + let rec expand dir t ~f : Unresolved.t = match t with | Run (prog, args) -> let args = List.concat_map args ~f:(E.strings ~dir ~f) in - let prog, more_args = E.prog_and_args ctx ~dir ~f prog in + let prog, more_args = E.prog_and_args ~dir ~f prog in Run (prog, more_args @ args) | Chdir (fn, t) -> let fn = E.path ~dir ~f fn in - Chdir (fn, expand ctx fn t ~f) + Chdir (fn, expand fn t ~f) | Setenv (var, value, t) -> Setenv (E.string ~dir ~f var, E.string ~dir ~f value, - expand ctx dir t ~f) + expand dir t ~f) | Redirect (outputs, fn, t) -> - Redirect (outputs, E.path ~dir ~f fn, expand ctx dir t ~f) + Redirect (outputs, E.path ~dir ~f fn, expand dir t ~f) | Ignore (outputs, t) -> - Ignore (outputs, expand ctx dir t ~f) - | Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f)) + Ignore (outputs, expand dir t ~f) + | Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f)) | Echo x -> Echo (E.string ~dir ~f x) | Cat x -> Cat (E.path ~dir ~f x) | Create_file x -> Create_file (E.path ~dir ~f x) @@ -339,13 +375,13 @@ module Unexpanded = struct ~generic:VE.path_of_string ~special:VE.to_path - let prog_and_args ctx ~dir ~f x = + let prog_and_args ~dir ~f x = expand ~dir ~f x - ~generic:(fun ~dir s -> (Program.resolve ctx ~dir s, [])) - ~special:(VE.to_prog_and_args ctx) + ~generic:(fun ~dir s -> (Unresolved.Program.of_string ~dir s, [])) + ~special:VE.to_prog_and_args end - let rec partial_expand ctx dir t ~f : Partial.t = + let rec partial_expand dir t ~f : Partial.t = match t with | Run (prog, args) -> let args = @@ -355,7 +391,7 @@ module Unexpanded = struct | Inr _ as x -> [x]) in begin - match E.prog_and_args ctx ~dir ~f prog with + match E.prog_and_args ~dir ~f prog with | Inl (prog, more_args) -> let more_args = List.map more_args ~f:(fun x -> Inl x) in Run (Inl prog, more_args @ args) @@ -366,7 +402,7 @@ module Unexpanded = struct let res = E.path ~dir ~f fn in match res with | Inl dir -> - Chdir (res, partial_expand ctx dir t ~f) + Chdir (res, partial_expand dir t ~f) | Inr fn -> let loc = SW.loc fn in Loc.fail loc @@ -375,12 +411,12 @@ module Unexpanded = struct end | Setenv (var, value, t) -> Setenv (E.string ~dir ~f var, E.string ~dir ~f value, - partial_expand ctx dir t ~f) + partial_expand dir t ~f) | Redirect (outputs, fn, t) -> - Redirect (outputs, E.path ~dir ~f fn, partial_expand ctx dir t ~f) + Redirect (outputs, E.path ~dir ~f fn, partial_expand dir t ~f) | Ignore (outputs, t) -> - Ignore (outputs, partial_expand ctx dir t ~f) - | Progn l -> Progn (List.map l ~f:(fun t -> partial_expand ctx dir t ~f)) + Ignore (outputs, partial_expand dir t ~f) + | Progn l -> Progn (List.map l ~f:(fun t -> partial_expand dir t ~f)) | Echo x -> Echo (E.string ~dir ~f x) | Cat x -> Cat (E.path ~dir ~f x) | Create_file x -> Create_file (E.path ~dir ~f x) @@ -426,35 +462,7 @@ let fold_one_step t ~init:acc ~f = | Remove_tree _ | Mkdir _ -> acc -let rec map t ~fs ~fp = - match t with - | Run (This prog, args) -> - Run (This (fp prog), List.map args ~f:fs) - | Run (Not_found _ as nf, args) -> - Run (nf, List.map args ~f:fs) - | Chdir (fn, t) -> - Chdir (fp fn, map t ~fs ~fp) - | Setenv (var, value, t) -> - Setenv (fs var, fs value, map t ~fs ~fp) - | Redirect (outputs, fn, t) -> - Redirect (outputs, fp fn, map t ~fs ~fp) - | Ignore (outputs, t) -> - Ignore (outputs, map t ~fs ~fp) - | Progn l -> Progn (List.map l ~f:(fun t -> map t ~fs ~fp)) - | Echo x -> Echo (fs x) - | Cat x -> Cat (fp x) - | Create_file x -> Create_file (fp x) - | Copy (x, y) -> Copy (fp x, fp y) - | Symlink (x, y) -> - Symlink (fp x, fp y) - | Copy_and_add_line_directive (x, y) -> - Copy_and_add_line_directive (fp x, fp y) - | System x -> System (fs x) - | Bash x -> Bash (fs x) - | Update_file (x, y) -> Update_file (fp x, fs y) - | Rename (x, y) -> Rename (fp x, fp y) - | Remove_tree x -> Remove_tree (fp x) - | Mkdir x -> Mkdir (fp x) +include Make_mapper(Ast)(Ast) let updated_files = let rec loop acc t = @@ -500,10 +508,8 @@ let run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args = let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = match t with - | Run (This prog, args) -> + | Run (prog, args) -> run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args - | Run (Not_found prog, _) -> - Utils.program_not_found prog ?context:(Option.map ectx.context ~f:(fun c -> c.name)) | Chdir (dir, t) -> exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to | Setenv (var, value, t) -> @@ -640,7 +646,7 @@ let sandbox t ~sandboxed ~deps ~targets = Some (Ast.Symlink (path, sandboxed path)) else None)) - ; map t ~fs:(fun x -> x) ~fp:sandboxed + ; map t ~f_string:(fun x -> x) ~f_path:sandboxed ~f_program:sandboxed ; Progn (List.filter_map targets ~f:(fun path -> if Path.is_local path then Some (Ast.Rename (sandboxed path, path)) @@ -663,8 +669,7 @@ module Infer = struct let rec infer acc t = match t with - | Run (This prog, _) -> acc +< prog - | Run (Not_found _, _) -> acc + | Run (prog, _) -> acc +< prog | Redirect (_, fn, t) -> infer (acc +@ fn) t | Cat fn -> acc +< fn | Create_file fn -> acc +@ fn diff --git a/src/action.mli b/src/action.mli index 6f30ca32..ff5ddf88 100644 --- a/src/action.mli +++ b/src/action.mli @@ -14,14 +14,8 @@ end module Outputs : module type of struct include Action_intf.Outputs end -module Program : sig - type t = - | This of Path.t - | Not_found of string -end - include Action_intf.Ast - with type program := Program.t + with type program := Path.t with type path := Path.t with type string := string @@ -34,9 +28,25 @@ val updated_files : t -> Path.Set.t (** Return the list of directories the action chdirs to *) val chdirs : t -> Path.Set.t -module Unexpanded : sig +(** Ast where programs are not yet looked up in the PATH *) +module Unresolved : sig type action = t + module Program : sig + type t = + | This of Path.t + | Search of string + end + + include Action_intf.Ast + with type program := Program.t + with type path := Path.t + with type string := string + + val resolve : t -> f:(string -> Path.t) -> action +end with type action := t + +module Unexpanded : sig include Action_intf.Ast with type program := String_with_vars.t with type path := String_with_vars.t @@ -47,25 +57,23 @@ module Unexpanded : sig module Partial : sig include Action_intf.Ast - with type program = (Program.t, String_with_vars.t) either - with type path = (Path.t , String_with_vars.t) either - with type string = (string , String_with_vars.t) either + with type program = (Unresolved.Program.t, String_with_vars.t) either + with type path = (Path.t , String_with_vars.t) either + with type string = (string , String_with_vars.t) either val expand - : Context.t - -> Path.t + : Path.t -> t -> f:(Loc.t -> String.t -> Var_expansion.t option) - -> action + -> Unresolved.t end val partial_expand - : Context.t - -> Path.t + : Path.t -> t -> f:(Loc.t -> string -> Var_expansion.t option) -> Partial.t -end with type action := t +end val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t diff --git a/src/build.ml b/src/build.ml index 87b12e0e..4e859b1f 100644 --- a/src/build.ml +++ b/src/build.ml @@ -216,7 +216,7 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[]) >>> Targets targets >>^ (fun (prog, args) -> - let action : Action.t = Run (This prog, args) in + let action : Action.t = Run (prog, args) in let action = match stdout_to with | None -> action diff --git a/src/super_context.ml b/src/super_context.ml index 775c5b76..86437f18 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -80,8 +80,11 @@ let expand_vars t ~dir s = | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir) | var -> String_map.find var t.vars) -let resolve_program t ?hint ?(in_the_tree=true) bin = - match Artifacts.binary t.artifacts ?hint ~in_the_tree bin with +let resolve_program_internal t ?hint ?(in_the_tree=true) bin = + Artifacts.binary t.artifacts ?hint ~in_the_tree bin + +let resolve_program t ?hint ?in_the_tree bin = + match resolve_program_internal t ?hint ?in_the_tree bin with | Error fail -> Build.Prog_spec.Dyn (fun _ -> fail.fail ()) | Ok path -> Build.Prog_spec.Dep path @@ -506,7 +509,7 @@ module Action = struct } in let t = - U.partial_expand sctx.context dir t ~f:(fun loc key -> + U.partial_expand dir t ~f:(fun loc key -> let module A = Artifacts in let open Action.Var_expansion in let cos, var = parse_bang key in @@ -596,7 +599,7 @@ module Action = struct let expand_step2 sctx ~dir ~artifacts ~targets_written_by_user ~deps_written_by_user t = let open Action.Var_expansion in - U.Partial.expand sctx.context dir t ~f:(fun _loc key -> + U.Partial.expand dir t ~f:(fun _loc key -> match String_map.find key artifacts with | Some _ as opt -> opt | None -> @@ -678,12 +681,18 @@ module Action = struct List.fold_left2 vdeps vals ~init:forms.artifacts ~f:(fun acc (var, _) value -> String_map.add acc ~key:var ~data:value) in - expand_step2 sctx ~dir ~artifacts - ~targets_written_by_user: - (match targets_written_by_user with - | Infer -> [] - | Static l -> l) - ~deps_written_by_user t) + let unresolved = + expand_step2 sctx ~dir ~artifacts + ~targets_written_by_user: + (match targets_written_by_user with + | Infer -> [] + | Static l -> l) + ~deps_written_by_user t + in + Action.Unresolved.resolve unresolved ~f:(fun prog -> + match resolve_program_internal sctx prog with + | Ok path -> path + | Error fail -> fail.fail ())) >>> Build.dyn_paths (Build.arr (fun action -> let { Action.Infer.Outcome.deps; targets = _ } =