prepare for change

This commit is contained in:
Jeremie Dimino 2017-03-03 08:18:10 +00:00
parent 8ddcf0b160
commit 304e4d9a7a
7 changed files with 49 additions and 52 deletions

View File

@ -164,23 +164,9 @@ let run ?(dir=Path.root) ?stdout_to ?env ?(extra_targets=[]) prog args =
Future.run Strict ~dir:(Path.to_string dir) ~stdout_to ?env Future.run Strict ~dir:(Path.to_string dir) ~stdout_to ?env
(Path.reach prog ~from:dir) args) (Path.reach prog ~from:dir) args)
let run_capture_gen ~f ?(dir=Path.root) ?env prog args =
let targets = Arg_spec.add_targets args [] in
prog_and_args ~dir prog args
>>>
prim ~targets
(fun (prog, args) ->
f ?dir:(Some (Path.to_string dir)) ?env
Future.Strict (Path.reach prog ~from:dir) args)
let run_capture ?dir ?env prog args =
run_capture_gen ~f:Future.run_capture ?dir ?env prog args
let run_capture_lines ?dir ?env prog args =
run_capture_gen ~f:Future.run_capture_lines ?dir ?env prog args
module Shexp = struct module Shexp = struct
open Future open Future
open Action.Mini_shexp open User_action.Mini_shexp
let run ~dir ~env ~env_extra ~stdout_to ~tail prog args = let run ~dir ~env ~env_extra ~stdout_to ~tail prog args =
let stdout_to : Future.stdout_to = let stdout_to : Future.stdout_to =
@ -270,9 +256,9 @@ module Shexp = struct
exec t ~dir ~env ~env_extra:String_map.empty ~stdout_to:None ~tail:true ~f exec t ~dir ~env ~env_extra:String_map.empty ~stdout_to:None ~tail:true ~f
end end
let action action ~dir ~env ~targets ~expand:f = let user_action action ~dir ~env ~targets ~expand:f =
prim ~targets (fun () -> prim ~targets (fun () ->
match (action : _ Action.t) with match (action : _ User_action.t) with
| Bash cmd -> | Bash cmd ->
Future.run Strict ~dir:(Path.to_string dir) ~env 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"; f ~dir cmd]

View File

@ -64,22 +64,8 @@ val run
-> 'a Arg_spec.t list -> 'a Arg_spec.t list
-> ('a, unit) t -> ('a, unit) t
val run_capture val user_action
: ?dir:Path.t : 'a User_action.t
-> ?env:string array
-> 'a Prog_spec.t
-> 'a Arg_spec.t list
-> ('a, string) t
val run_capture_lines
: ?dir:Path.t
-> ?env:string array
-> 'a Prog_spec.t
-> 'a Arg_spec.t list
-> ('a, string list) t
val action
: 'a Action.t
-> dir:Path.t -> dir:Path.t
-> env:string array -> env:string array
-> targets:Path.t list -> targets:Path.t list

View File

@ -289,12 +289,6 @@ module Gen(P : Params) = struct
let run ?(dir=ctx.build_dir) ?stdout_to ?(env=ctx.env) ?extra_targets prog args = let run ?(dir=ctx.build_dir) ?stdout_to ?(env=ctx.env) ?extra_targets prog args =
Build.run ~dir ?stdout_to ~env ?extra_targets prog args Build.run ~dir ?stdout_to ~env ?extra_targets prog args
let run_capture ?(dir=ctx.build_dir) ?(env=ctx.env) prog args =
Build.run_capture ~dir ~env prog args
let run_capture_lines ?(dir=ctx.build_dir) ?(env=ctx.env) prog args =
Build.run_capture_lines ~dir ~env prog args
let bash ?dir ?stdout_to ?env ?extra_targets cmd = let bash ?dir ?stdout_to ?env ?extra_targets cmd =
run (Dep (Path.absolute "/bin/bash")) ?dir ?stdout_to ?env ?extra_targets run (Dep (Path.absolute "/bin/bash")) ?dir ?stdout_to ?env ?extra_targets
[ As ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] ] [ As ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] ]
@ -512,9 +506,16 @@ module Gen(P : Params) = struct
| Impl, _ -> S [A "-impl"; Dep fn] | Impl, _ -> S [A "-impl"; Dep fn]
| Intf, _ -> S [A "-intf"; Dep fn]) | Intf, _ -> S [A "-intf"; Dep fn])
in in
let ocamldep_output =
Path.relative dir (sprintf "%s.depends%s.ocamldep-output" item suffix)
in
add_rule add_rule
(Build.run_capture_lines (Dep ctx.ocamldep) [A "-modules"; S files] (Build.run (Dep ctx.ocamldep) [A "-modules"; S files] ~stdout_to:ocamldep_output);
>>^ parse_deps ~dir ~modules ~alias_module add_rule
(Build.path ocamldep_output
>>^ (fun () ->
parse_deps ~dir ~modules ~alias_module
(lines_of_file (Path.to_string ocamldep_output)))
>>> Build.store_vfile vdepends); >>> Build.store_vfile vdepends);
Build.vpath vdepends Build.vpath vdepends
@ -1292,16 +1293,16 @@ module Gen(P : Params) = struct
| User actions | | User actions |
+-----------------------------------------------------------------+ *) +-----------------------------------------------------------------+ *)
module Action_interpret : sig module User_action_interpret : sig
val run val run
: Action.Unexpanded.t : User_action.Unexpanded.t
-> dir:Path.t -> dir:Path.t
-> dep_kind:Build.lib_dep_kind -> dep_kind:Build.lib_dep_kind
-> targets:Path.t list -> targets:Path.t list
-> deps:Dep_conf.t list -> deps:Dep_conf.t list
-> (unit, unit) Build.t -> (unit, unit) Build.t
end = struct end = struct
module U = Action.Unexpanded module U = User_action.Unexpanded
type resolved_forms = type resolved_forms =
{ (* Mapping from ${...} forms to their resolutions *) { (* Mapping from ${...} forms to their resolutions *)
@ -1388,7 +1389,7 @@ module Gen(P : Params) = struct
>>> >>>
Build.paths (String_map.values forms.artifacts) Build.paths (String_map.values forms.artifacts)
>>> >>>
Build.action t ~dir ~env:ctx.env ~targets Build.user_action t ~dir ~env:ctx.env ~targets
~expand:(expand_string_with_vars ~artifacts:forms.artifacts ~targets ~deps) ~expand:(expand_string_with_vars ~artifacts:forms.artifacts ~targets ~deps)
in in
match forms.failures with match forms.failures with
@ -1405,7 +1406,7 @@ module Gen(P : Params) = struct
add_rule add_rule
(Dep_conf_interpret.dep_of_list ~dir rule.deps (Dep_conf_interpret.dep_of_list ~dir rule.deps
>>> >>>
Action_interpret.run User_action_interpret.run
rule.action rule.action
~dir ~dir
~dep_kind:Required ~dep_kind:Required
@ -1419,7 +1420,7 @@ module Gen(P : Params) = struct
let action = let action =
match alias_conf.action with match alias_conf.action with
| None -> Sexp.Atom "none" | None -> Sexp.Atom "none"
| Some a -> List [Atom "some" ; Action.Unexpanded.sexp_of_t a] in | Some a -> List [Atom "some" ; User_action.Unexpanded.sexp_of_t a] in
Sexp.List [deps ; action] Sexp.List [deps ; action]
|> Sexp.to_string |> Sexp.to_string
|> Digest.string |> Digest.string
@ -1434,7 +1435,7 @@ module Gen(P : Params) = struct
| None -> deps | None -> deps
| Some action -> | Some action ->
deps deps
>>> Action_interpret.run >>> User_action_interpret.run
action action
~dir ~dir
~dep_kind:Required ~dep_kind:Required

View File

@ -546,13 +546,13 @@ module Rule = struct
type t = type t =
{ targets : string list (** List of files in the current directory *) { targets : string list (** List of files in the current directory *)
; deps : Dep_conf.t list ; deps : Dep_conf.t list
; action : Action.Unexpanded.t ; action : User_action.Unexpanded.t
} }
let common = let common =
field "targets" (list file_in_current_dir) >>= fun targets -> field "targets" (list file_in_current_dir) >>= fun targets ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps -> field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field "action" Action.Unexpanded.t >>= fun action -> field "action" User_action.Unexpanded.t >>= fun action ->
return { targets; deps; action } return { targets; deps; action }
let v1 = record common let v1 = record common
@ -660,13 +660,13 @@ module Alias_conf = struct
type t = type t =
{ name : string { name : string
; deps : Dep_conf.t list ; deps : Dep_conf.t list
; action : Action.Unexpanded.t option ; action : User_action.Unexpanded.t option
} }
let common = let common =
field "name" string >>= fun name -> field "name" string >>= fun name ->
field "deps" (list Dep_conf.t) ~default:[] >>= fun deps -> field "deps" (list Dep_conf.t) ~default:[] >>= fun deps ->
field_o "action" Action.Unexpanded.t >>= fun action -> field_o "action" User_action.Unexpanded.t >>= fun action ->
return return
{ name { name
; deps ; deps

View File

@ -270,3 +270,25 @@ let rmdir t = Unix.rmdir (to_string t)
let unlink t = Unix.unlink (to_string t) let unlink t = Unix.unlink (to_string t)
let extend_basename t ~suffix = t ^ suffix let extend_basename t ~suffix = t ^ suffix
let insert_after_build_dir_exn =
let error a b =
Sexp.code_error
"Path.insert_after_build_dir_exn"
[ "path" , Atom a
; "insert", Atom b
]
in
fun a b ->
if not (is_local a && is_local b) then error a b;
match String.lsplit2 a ~on:'/' with
| Some ("_build", rest) ->
if is_root b then
a
else
sprintf "_build/%s/%s" b rest
| _ ->
error a b

View File

@ -60,6 +60,8 @@ val extract_build_context : t -> (string * t) option
val extract_build_context_dir : t -> (t * t) option val extract_build_context_dir : t -> (t * t) option
val is_in_build_dir : t -> bool val is_in_build_dir : t -> bool
val insert_after_build_dir_exn : t -> t -> t
val exists : t -> bool val exists : t -> bool
val readdir : t -> string list val readdir : t -> string list
val is_directory : t -> bool val is_directory : t -> bool