Make (run prog ...) behave the same as (run ${bin:prog} ...)
This just seems like a better default
This commit is contained in:
parent
5307a92ddc
commit
e4300e7b51
|
@ -50,6 +50,10 @@
|
||||||
- Automatically add the `.exe` when installing executables on Windows
|
- Automatically add the `.exe` when installing executables on Windows
|
||||||
(#123)
|
(#123)
|
||||||
|
|
||||||
|
- `(run <prog> ...)` now resolves `<prog>` 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
|
- Fix a bug where `jbuild rules` would crash instead of reporting a
|
||||||
proper build error
|
proper build error
|
||||||
|
|
||||||
|
|
|
@ -558,10 +558,13 @@ In addition, ``(action ...)`` fields support the following special variables:
|
||||||
- ``path:<path>`` expands to ``<path>``
|
- ``path:<path>`` expands to ``<path>``
|
||||||
- ``exe:<path>`` is the same as ``<path>``, except when cross-compiling, in
|
- ``exe:<path>`` is the same as ``<path>``, except when cross-compiling, in
|
||||||
which case it will expand to ``<path>`` from the host build context
|
which case it will expand to ``<path>`` from the host build context
|
||||||
- ``bin:<program>`` expands to a path to ``program``. If ``program`` is
|
- ``bin:<program>`` expands to a path to ``program``. If ``program``
|
||||||
installed by a package in the workspace (see `install`_ stanzas), the locally
|
is installed by a package in the workspace (see `install`_ stanzas),
|
||||||
built binary will be used, otherwise it will be searched in the ``PATH`` of
|
the locally built binary will be used, otherwise it will be searched
|
||||||
the current build context
|
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:<public-library-name>:<file>`` expands to a path to file ``<file>`` of
|
- ``lib:<public-library-name>:<file>`` expands to a path to file ``<file>`` of
|
||||||
library ``<public-library-name>``. If ``<public-library-name>`` is available
|
library ``<public-library-name>``. If ``<public-library-name>`` is available
|
||||||
in the current workspace, the local file will be used, otherwise the one from
|
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:
|
The following constructions are available:
|
||||||
|
|
||||||
- ``(run <prog> <args>)`` to execute a program
|
- ``(run <prog> <args>)`` to execute a program. ``<prog>`` is resolved
|
||||||
|
locally if it is available in the current workspace, otherwise it is
|
||||||
|
resolved using the ``PATH``
|
||||||
- ``(chdir <dir> <DSL>)`` to change the current directory
|
- ``(chdir <dir> <DSL>)`` to change the current directory
|
||||||
- ``(setenv <var> <value> <DSL>)`` to set an environment variable
|
- ``(setenv <var> <value> <DSL>)`` to set an environment variable
|
||||||
- ``(with-<outputs>-to <file> <DSL>)`` to redirect the output to a file, where
|
- ``(with-<outputs>-to <file> <DSL>)`` to redirect the output to a file, where
|
||||||
|
|
295
src/action.ml
295
src/action.ml
|
@ -3,94 +3,6 @@ open Sexp.Of_sexp
|
||||||
|
|
||||||
module Env_var_map = Context.Env_var_map
|
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 <atom> or (not_found <atom>) 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
|
module Outputs = struct
|
||||||
include Action_intf.Outputs
|
include Action_intf.Outputs
|
||||||
|
|
||||||
|
@ -181,14 +93,47 @@ struct
|
||||||
| Mkdir x -> List [Atom "mkdir"; path x]
|
| Mkdir x -> List [Atom "mkdir"; path x]
|
||||||
end
|
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
|
module type Ast = Action_intf.Ast
|
||||||
with type program = Program.t
|
with type program = Path.t
|
||||||
with type path = Path.t
|
with type path = Path.t
|
||||||
with type string = String.t
|
with type string = String.t
|
||||||
module rec Ast : Ast = Ast
|
module rec Ast : Ast = Ast
|
||||||
|
|
||||||
include Make_ast
|
include Make_ast
|
||||||
(Program)
|
(Path)
|
||||||
(Path)
|
(Path)
|
||||||
(struct
|
(struct
|
||||||
type t = string
|
type t = string
|
||||||
|
@ -197,6 +142,95 @@ include Make_ast
|
||||||
end)
|
end)
|
||||||
(Ast)
|
(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 Unexpanded = struct
|
||||||
module type Uast = Action_intf.Ast
|
module type Uast = Action_intf.Ast
|
||||||
with type program = String_with_vars.t
|
with type program = String_with_vars.t
|
||||||
|
@ -221,6 +255,8 @@ module Unexpanded = struct
|
||||||
Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path])
|
Sexp.pp (List [Atom "mkdir"; Path.sexp_of_t path])
|
||||||
|
|
||||||
module Partial = struct
|
module Partial = struct
|
||||||
|
module Program = Unresolved.Program
|
||||||
|
|
||||||
module type Past = Action_intf.Ast
|
module type Past = Action_intf.Ast
|
||||||
with type program = (Program.t, String_with_vars.t) either
|
with type program = (Program.t, String_with_vars.t) either
|
||||||
with type path = (Path.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
|
~special:VE.to_path
|
||||||
~map:(fun x -> x)
|
~map:(fun x -> x)
|
||||||
|
|
||||||
let prog_and_args ctx ~dir ~f x =
|
let prog_and_args ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
~generic:(fun ~dir:_ s -> (Program.resolve ctx ~dir s, []))
|
~generic:(fun ~dir:_ s -> (Program.of_string ~dir s, []))
|
||||||
~special:(VE.to_prog_and_args ctx)
|
~special:VE.to_prog_and_args
|
||||||
~map:(fun x -> (x, []))
|
~map:(fun x -> (x, []))
|
||||||
end
|
end
|
||||||
|
|
||||||
let rec expand ctx dir t ~f : Ast.t =
|
let rec expand dir t ~f : Unresolved.t =
|
||||||
match t with
|
match t with
|
||||||
| Run (prog, args) ->
|
| Run (prog, args) ->
|
||||||
let args = List.concat_map args ~f:(E.strings ~dir ~f) in
|
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)
|
Run (prog, more_args @ args)
|
||||||
| Chdir (fn, t) ->
|
| Chdir (fn, t) ->
|
||||||
let fn = E.path ~dir ~f fn in
|
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 (var, value, t) ->
|
||||||
Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
|
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, 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, t) ->
|
||||||
Ignore (outputs, expand ctx dir t ~f)
|
Ignore (outputs, expand dir t ~f)
|
||||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand ctx dir t ~f))
|
| Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
|
||||||
| Echo x -> Echo (E.string ~dir ~f x)
|
| Echo x -> Echo (E.string ~dir ~f x)
|
||||||
| Cat x -> Cat (E.path ~dir ~f x)
|
| Cat x -> Cat (E.path ~dir ~f x)
|
||||||
| Create_file x -> Create_file (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
|
~generic:VE.path_of_string
|
||||||
~special:VE.to_path
|
~special:VE.to_path
|
||||||
|
|
||||||
let prog_and_args ctx ~dir ~f x =
|
let prog_and_args ~dir ~f x =
|
||||||
expand ~dir ~f x
|
expand ~dir ~f x
|
||||||
~generic:(fun ~dir s -> (Program.resolve ctx ~dir s, []))
|
~generic:(fun ~dir s -> (Unresolved.Program.of_string ~dir s, []))
|
||||||
~special:(VE.to_prog_and_args ctx)
|
~special:VE.to_prog_and_args
|
||||||
end
|
end
|
||||||
|
|
||||||
let rec partial_expand ctx dir t ~f : Partial.t =
|
let rec partial_expand dir t ~f : Partial.t =
|
||||||
match t with
|
match t with
|
||||||
| Run (prog, args) ->
|
| Run (prog, args) ->
|
||||||
let args =
|
let args =
|
||||||
|
@ -355,7 +391,7 @@ module Unexpanded = struct
|
||||||
| Inr _ as x -> [x])
|
| Inr _ as x -> [x])
|
||||||
in
|
in
|
||||||
begin
|
begin
|
||||||
match E.prog_and_args ctx ~dir ~f prog with
|
match E.prog_and_args ~dir ~f prog with
|
||||||
| Inl (prog, more_args) ->
|
| Inl (prog, more_args) ->
|
||||||
let more_args = List.map more_args ~f:(fun x -> Inl x) in
|
let more_args = List.map more_args ~f:(fun x -> Inl x) in
|
||||||
Run (Inl prog, more_args @ args)
|
Run (Inl prog, more_args @ args)
|
||||||
|
@ -366,7 +402,7 @@ module Unexpanded = struct
|
||||||
let res = E.path ~dir ~f fn in
|
let res = E.path ~dir ~f fn in
|
||||||
match res with
|
match res with
|
||||||
| Inl dir ->
|
| Inl dir ->
|
||||||
Chdir (res, partial_expand ctx dir t ~f)
|
Chdir (res, partial_expand dir t ~f)
|
||||||
| Inr fn ->
|
| Inr fn ->
|
||||||
let loc = SW.loc fn in
|
let loc = SW.loc fn in
|
||||||
Loc.fail loc
|
Loc.fail loc
|
||||||
|
@ -375,12 +411,12 @@ module Unexpanded = struct
|
||||||
end
|
end
|
||||||
| Setenv (var, value, t) ->
|
| Setenv (var, value, t) ->
|
||||||
Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
|
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, 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, t) ->
|
||||||
Ignore (outputs, partial_expand ctx dir t ~f)
|
Ignore (outputs, partial_expand dir t ~f)
|
||||||
| Progn l -> Progn (List.map l ~f:(fun t -> partial_expand ctx 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)
|
| Echo x -> Echo (E.string ~dir ~f x)
|
||||||
| Cat x -> Cat (E.path ~dir ~f x)
|
| Cat x -> Cat (E.path ~dir ~f x)
|
||||||
| Create_file x -> Create_file (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 _
|
| Remove_tree _
|
||||||
| Mkdir _ -> acc
|
| Mkdir _ -> acc
|
||||||
|
|
||||||
let rec map t ~fs ~fp =
|
include Make_mapper(Ast)(Ast)
|
||||||
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)
|
|
||||||
|
|
||||||
let updated_files =
|
let updated_files =
|
||||||
let rec loop acc t =
|
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 =
|
let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to =
|
||||||
match t with
|
match t with
|
||||||
| Run (This prog, args) ->
|
| Run (prog, args) ->
|
||||||
run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to 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) ->
|
| Chdir (dir, t) ->
|
||||||
exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to
|
exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to
|
||||||
| Setenv (var, value, t) ->
|
| Setenv (var, value, t) ->
|
||||||
|
@ -640,7 +646,7 @@ let sandbox t ~sandboxed ~deps ~targets =
|
||||||
Some (Ast.Symlink (path, sandboxed path))
|
Some (Ast.Symlink (path, sandboxed path))
|
||||||
else
|
else
|
||||||
None))
|
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 ->
|
; Progn (List.filter_map targets ~f:(fun path ->
|
||||||
if Path.is_local path then
|
if Path.is_local path then
|
||||||
Some (Ast.Rename (sandboxed path, path))
|
Some (Ast.Rename (sandboxed path, path))
|
||||||
|
@ -663,8 +669,7 @@ module Infer = struct
|
||||||
|
|
||||||
let rec infer acc t =
|
let rec infer acc t =
|
||||||
match t with
|
match t with
|
||||||
| Run (This prog, _) -> acc +< prog
|
| Run (prog, _) -> acc +< prog
|
||||||
| Run (Not_found _, _) -> acc
|
|
||||||
| Redirect (_, fn, t) -> infer (acc +@ fn) t
|
| Redirect (_, fn, t) -> infer (acc +@ fn) t
|
||||||
| Cat fn -> acc +< fn
|
| Cat fn -> acc +< fn
|
||||||
| Create_file fn -> acc +@ fn
|
| Create_file fn -> acc +@ fn
|
||||||
|
|
|
@ -14,14 +14,8 @@ end
|
||||||
|
|
||||||
module Outputs : module type of struct include Action_intf.Outputs 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
|
include Action_intf.Ast
|
||||||
with type program := Program.t
|
with type program := Path.t
|
||||||
with type path := Path.t
|
with type path := Path.t
|
||||||
with type string := string
|
with type string := string
|
||||||
|
|
||||||
|
@ -34,9 +28,25 @@ val updated_files : t -> Path.Set.t
|
||||||
(** Return the list of directories the action chdirs to *)
|
(** Return the list of directories the action chdirs to *)
|
||||||
val chdirs : t -> Path.Set.t
|
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
|
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
|
include Action_intf.Ast
|
||||||
with type program := String_with_vars.t
|
with type program := String_with_vars.t
|
||||||
with type path := String_with_vars.t
|
with type path := String_with_vars.t
|
||||||
|
@ -47,25 +57,23 @@ module Unexpanded : sig
|
||||||
|
|
||||||
module Partial : sig
|
module Partial : sig
|
||||||
include Action_intf.Ast
|
include Action_intf.Ast
|
||||||
with type program = (Program.t, 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 path = (Path.t , String_with_vars.t) either
|
||||||
with type string = (string , String_with_vars.t) either
|
with type string = (string , String_with_vars.t) either
|
||||||
|
|
||||||
val expand
|
val expand
|
||||||
: Context.t
|
: Path.t
|
||||||
-> Path.t
|
|
||||||
-> t
|
-> t
|
||||||
-> f:(Loc.t -> String.t -> Var_expansion.t option)
|
-> f:(Loc.t -> String.t -> Var_expansion.t option)
|
||||||
-> action
|
-> Unresolved.t
|
||||||
end
|
end
|
||||||
|
|
||||||
val partial_expand
|
val partial_expand
|
||||||
: Context.t
|
: Path.t
|
||||||
-> Path.t
|
|
||||||
-> t
|
-> t
|
||||||
-> f:(Loc.t -> string -> Var_expansion.t option)
|
-> f:(Loc.t -> string -> Var_expansion.t option)
|
||||||
-> Partial.t
|
-> Partial.t
|
||||||
end with type action := t
|
end
|
||||||
|
|
||||||
val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t
|
val exec : targets:Path.Set.t -> ?context:Context.t -> t -> unit Future.t
|
||||||
|
|
||||||
|
|
|
@ -216,7 +216,7 @@ let run ~context ?(dir=context.Context.build_dir) ?stdout_to ?(extra_targets=[])
|
||||||
>>>
|
>>>
|
||||||
Targets targets
|
Targets targets
|
||||||
>>^ (fun (prog, args) ->
|
>>^ (fun (prog, args) ->
|
||||||
let action : Action.t = Run (This prog, args) in
|
let action : Action.t = Run (prog, args) in
|
||||||
let action =
|
let action =
|
||||||
match stdout_to with
|
match stdout_to with
|
||||||
| None -> action
|
| None -> action
|
||||||
|
|
|
@ -80,8 +80,11 @@ let expand_vars t ~dir s =
|
||||||
| "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
|
| "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir)
|
||||||
| var -> String_map.find var t.vars)
|
| var -> String_map.find var t.vars)
|
||||||
|
|
||||||
let resolve_program t ?hint ?(in_the_tree=true) bin =
|
let resolve_program_internal t ?hint ?(in_the_tree=true) bin =
|
||||||
match Artifacts.binary t.artifacts ?hint ~in_the_tree bin with
|
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 ())
|
| Error fail -> Build.Prog_spec.Dyn (fun _ -> fail.fail ())
|
||||||
| Ok path -> Build.Prog_spec.Dep path
|
| Ok path -> Build.Prog_spec.Dep path
|
||||||
|
|
||||||
|
@ -506,7 +509,7 @@ module Action = struct
|
||||||
}
|
}
|
||||||
in
|
in
|
||||||
let t =
|
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 module A = Artifacts in
|
||||||
let open Action.Var_expansion in
|
let open Action.Var_expansion in
|
||||||
let cos, var = parse_bang key in
|
let cos, var = parse_bang key in
|
||||||
|
@ -596,7 +599,7 @@ module Action = struct
|
||||||
let expand_step2 sctx ~dir ~artifacts
|
let expand_step2 sctx ~dir ~artifacts
|
||||||
~targets_written_by_user ~deps_written_by_user t =
|
~targets_written_by_user ~deps_written_by_user t =
|
||||||
let open Action.Var_expansion in
|
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
|
match String_map.find key artifacts with
|
||||||
| Some _ as opt -> opt
|
| Some _ as opt -> opt
|
||||||
| None ->
|
| None ->
|
||||||
|
@ -678,12 +681,18 @@ module Action = struct
|
||||||
List.fold_left2 vdeps vals ~init:forms.artifacts ~f:(fun acc (var, _) value ->
|
List.fold_left2 vdeps vals ~init:forms.artifacts ~f:(fun acc (var, _) value ->
|
||||||
String_map.add acc ~key:var ~data:value)
|
String_map.add acc ~key:var ~data:value)
|
||||||
in
|
in
|
||||||
expand_step2 sctx ~dir ~artifacts
|
let unresolved =
|
||||||
~targets_written_by_user:
|
expand_step2 sctx ~dir ~artifacts
|
||||||
(match targets_written_by_user with
|
~targets_written_by_user:
|
||||||
| Infer -> []
|
(match targets_written_by_user with
|
||||||
| Static l -> l)
|
| Infer -> []
|
||||||
~deps_written_by_user t)
|
| 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 ->
|
Build.dyn_paths (Build.arr (fun action ->
|
||||||
let { Action.Infer.Outcome.deps; targets = _ } =
|
let { Action.Infer.Outcome.deps; targets = _ } =
|
||||||
|
|
Loading…
Reference in New Issue