From 304e4d9a7a2b928aca6997f28f0a2c086a5aefcd Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Fri, 3 Mar 2017 08:18:10 +0000 Subject: [PATCH] prepare for change --- src/build.ml | 20 +++----------------- src/build.mli | 18 ++---------------- src/gen_rules.ml | 31 ++++++++++++++++--------------- src/jbuild_types.ml | 8 ++++---- src/path.ml | 22 ++++++++++++++++++++++ src/path.mli | 2 ++ src/{action.ml => user_action.ml} | 0 7 files changed, 49 insertions(+), 52 deletions(-) rename src/{action.ml => user_action.ml} (100%) diff --git a/src/build.ml b/src/build.ml index 73eb6360..36b53fb8 100644 --- a/src/build.ml +++ b/src/build.ml @@ -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 (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 open Future - open Action.Mini_shexp + open User_action.Mini_shexp let run ~dir ~env ~env_extra ~stdout_to ~tail prog args = 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 end -let action action ~dir ~env ~targets ~expand:f = +let user_action action ~dir ~env ~targets ~expand:f = prim ~targets (fun () -> - match (action : _ Action.t) with + 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] diff --git a/src/build.mli b/src/build.mli index ebde3cc3..41877426 100644 --- a/src/build.mli +++ b/src/build.mli @@ -64,22 +64,8 @@ val run -> 'a Arg_spec.t list -> ('a, unit) t -val run_capture - : ?dir:Path.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 +val user_action + : 'a User_action.t -> dir:Path.t -> env:string array -> targets:Path.t list diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 12c094db..b418e279 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -289,12 +289,6 @@ module Gen(P : Params) = struct 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 - 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 = run (Dep (Path.absolute "/bin/bash")) ?dir ?stdout_to ?env ?extra_targets [ As ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] ] @@ -512,9 +506,16 @@ module Gen(P : Params) = struct | Impl, _ -> S [A "-impl"; Dep fn] | Intf, _ -> S [A "-intf"; Dep fn]) in + let ocamldep_output = + Path.relative dir (sprintf "%s.depends%s.ocamldep-output" item suffix) + in add_rule - (Build.run_capture_lines (Dep ctx.ocamldep) [A "-modules"; S files] - >>^ parse_deps ~dir ~modules ~alias_module + (Build.run (Dep ctx.ocamldep) [A "-modules"; S files] ~stdout_to:ocamldep_output); + 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.vpath vdepends @@ -1292,16 +1293,16 @@ module Gen(P : Params) = struct | User actions | +-----------------------------------------------------------------+ *) - module Action_interpret : sig + module User_action_interpret : sig val run - : Action.Unexpanded.t + : User_action.Unexpanded.t -> dir:Path.t -> dep_kind:Build.lib_dep_kind -> targets:Path.t list -> deps:Dep_conf.t list -> (unit, unit) Build.t end = struct - module U = Action.Unexpanded + module U = User_action.Unexpanded type resolved_forms = { (* Mapping from ${...} forms to their resolutions *) @@ -1388,7 +1389,7 @@ module Gen(P : Params) = struct >>> 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) in match forms.failures with @@ -1405,7 +1406,7 @@ module Gen(P : Params) = struct add_rule (Dep_conf_interpret.dep_of_list ~dir rule.deps >>> - Action_interpret.run + User_action_interpret.run rule.action ~dir ~dep_kind:Required @@ -1419,7 +1420,7 @@ module Gen(P : Params) = struct let action = match alias_conf.action with | 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.to_string |> Digest.string @@ -1434,7 +1435,7 @@ module Gen(P : Params) = struct | None -> deps | Some action -> deps - >>> Action_interpret.run + >>> User_action_interpret.run action ~dir ~dep_kind:Required diff --git a/src/jbuild_types.ml b/src/jbuild_types.ml index 78d844bf..f8a3e68f 100644 --- a/src/jbuild_types.ml +++ b/src/jbuild_types.ml @@ -546,13 +546,13 @@ module Rule = struct type t = { targets : string list (** List of files in the current directory *) ; deps : Dep_conf.t list - ; action : Action.Unexpanded.t + ; action : User_action.Unexpanded.t } let common = field "targets" (list file_in_current_dir) >>= fun targets -> 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 } let v1 = record common @@ -660,13 +660,13 @@ module Alias_conf = struct type t = { name : string ; deps : Dep_conf.t list - ; action : Action.Unexpanded.t option + ; action : User_action.Unexpanded.t option } let common = field "name" string >>= fun name -> 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 { name ; deps diff --git a/src/path.ml b/src/path.ml index 2347140e..7f0a91d1 100644 --- a/src/path.ml +++ b/src/path.ml @@ -270,3 +270,25 @@ let rmdir t = Unix.rmdir (to_string t) let unlink t = Unix.unlink (to_string t) 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 + + + diff --git a/src/path.mli b/src/path.mli index 7987285b..b5610296 100644 --- a/src/path.mli +++ b/src/path.mli @@ -60,6 +60,8 @@ val extract_build_context : t -> (string * t) option val extract_build_context_dir : t -> (t * t) option val is_in_build_dir : t -> bool +val insert_after_build_dir_exn : t -> t -> t + val exists : t -> bool val readdir : t -> string list val is_directory : t -> bool diff --git a/src/action.ml b/src/user_action.ml similarity index 100% rename from src/action.ml rename to src/user_action.ml