matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Write_file --> Update_file

This commit is contained in:
Jeremie Dimino 2017-03-06 14:34:53 +00:00
parent a90b436020
commit 7850bf67f5
7 changed files with 153 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/action.ml
View File

@ -68,7 +68,7 @@ module Mini_shexp = struct
| Copy_and_add_line_directive of 'path * 'path
| System of 'a
| Bash of 'a
| Write_file of 'path * 'a
| Update_file of 'path * 'a
let rec t a p sexp =
sum
@ -109,7 +109,7 @@ module Mini_shexp = struct
List [Atom "copy-and-add-line-directive"; g x; g y]
| System x -> List [Atom "system"; f x]
| Bash x -> List [Atom "bash"; f x]
| Write_file (x, y) -> List [Atom "write-file"; g x; f y]
| Update_file (x, y) -> List [Atom "write-file"; g x; f y]
let rec fold t ~init:acc ~f =
match t with
@ -126,7 +126,7 @@ module Mini_shexp = struct
| Copy_and_add_line_directive (x, y) -> f (f acc x) y
| System x -> f acc x
| Bash x -> f acc x
| Write_file (x, y) -> f (f acc x) y
| Update_file (x, y) -> f (f acc x) y
end
open Ast
@ -174,7 +174,7 @@ module Mini_shexp = struct
Copy_and_add_line_directive (expand_path ~dir ~f x, expand_path ~dir ~f y)
| System x -> System (expand_str ~dir ~f x)
| Bash x -> Bash (expand_str ~dir ~f x)
| Write_file (x, y) -> Write_file (expand_path ~dir ~f x, expand_str ~dir ~f y)
| Update_file (x, y) -> Update_file (expand_path ~dir ~f x, expand_str ~dir ~f y)
end
open Future
@ -273,7 +273,7 @@ module Mini_shexp = struct
run ~dir ~env ~env_extra ~stdout_to ~tail
(Path.absolute "/bin/bash")
["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd]
| Write_file (fn, s) ->
| Update_file (fn, s) ->
let fn = Path.to_string fn in
if Sys.file_exists fn && read_file fn = s then
()

2
src/action.mli
View File

@ -22,7 +22,7 @@ module Mini_shexp : sig
| Copy_and_add_line_directive of 'path * 'path
| System of 'a
| Bash of 'a
| Write_file of 'path * 'a
| Update_file of 'path * 'a
val t : 'a Sexp.Of_sexp.t -> 'b Sexp.Of_sexp.t -> ('a, 'b) t Sexp.Of_sexp.t
val sexp_of_t : 'a Sexp.To_sexp.t -> 'b Sexp.To_sexp.t -> ('a, 'b) t Sexp.To_sexp.t
end

8
src/build.ml
View File

@ -167,16 +167,16 @@ let action ?(dir=Path.root) ?context ~targets action =
>>^ fun () ->
{ Action. context; dir; action }
let echo fn s =
action ~targets:[fn] (Write_file (fn, s))
let update_file fn s =
action ~targets:[fn] (Update_file (fn, s))
let echo_dyn fn =
let update_file_dyn fn =
Targets [fn]
>>^ fun s ->
{ Action.
context = None
; dir = Path.root
; action = Write_file (fn, s)
; action = Update_file (fn, s)
}
let copy ~src ~dst =

4
src/build.mli
View File

@ -73,8 +73,8 @@ val action
(** Create a file with the given contents. Do not ovewrite the file if
it hasn't changed. *)
val echo : Path.t -> string -> (unit, Action.t) t
val echo_dyn : Path.t -> (string, Action.t) t
val update_file : Path.t -> string -> (unit, Action.t) t
val update_file_dyn : Path.t -> (string, Action.t) t
val copy : src:Path.t -> dst:Path.t -> (unit, Action.t) t

2
src/build_system.ml
View File

@ -195,7 +195,7 @@ module Build_exec = struct
{ Action.
context = None
; dir = Path.root
; action = Write_file (fn, vfile_to_string kind fn x)
; action = Update_file (fn, vfile_to_string kind fn x)
}
| Compose (a, b) ->
exec a x |> exec b

271
src/gen_rules.ml
View File

@ -435,10 +435,12 @@ module Gen(P : Params) = struct
loop (Build.return ()) ts
let only_plain_file ~dir = function
| File s -> Some (expand_vars ~dir s)
| File s -> Some (Path.relative dir (expand_vars ~dir s))
| Alias _ -> None
| Glob_files _ -> None
| Files_recursively_in _ -> None
let only_plain_files ~dir ts = List.map ts ~f:(only_plain_file ~dir)
end
(* +-----------------------------------------------------------------+
@ -538,13 +540,127 @@ module Gen(P : Params) = struct
|> modules_of_names ~dir ~modules
|> cm_files ~dir ~cm_kind:(Mode.cm_kind mode)
(* +-----------------------------------------------------------------+
| Preprocessing stuff |
+-----------------------------------------------------------------+ *)
let ocamldep_rules ~dir ~item ~modules ~alias_module =
Ml_kind.Dict.of_func (ocamldep_rules ~dir ~item ~modules ~alias_module)
(* +-----------------------------------------------------------------+
| User actions |
+-----------------------------------------------------------------+ *)
module Action_interpret : sig
val run
: Action.Mini_shexp.Unexpanded.t
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> targets:Path.t list
-> deps:Path.t option list
-> (unit, Action.t) Build.t
end = struct
module U = Action.Mini_shexp.Unexpanded
type resolved_forms =
{ (* Mapping from ${...} forms to their resolutions *)
artifacts : Path.t String_map.t
; (* Failed resolutions *)
failures : fail list
; (* All "name" for ${lib:name:...} forms *)
lib_deps : String_set.t
}
let add_artifact ?lib_dep acc ~var result =
let lib_deps =
match lib_dep with
| None -> acc.lib_deps
| Some lib -> String_set.add lib acc.lib_deps
in
match result with
| Ok path ->
{ acc with
artifacts = String_map.add acc.artifacts ~key:var ~data:path
; lib_deps
}
| Error fail ->
{ acc with
failures = fail :: acc.failures
; lib_deps
}
let extract_artifacts ~dir t =
let init =
{ artifacts = String_map.empty
; failures = []
; lib_deps = String_set.empty
}
in
U.fold_vars t ~init ~f:(fun acc var ->
let module A = Artifacts in
match String.lsplit2 var ~on:':' with
| Some ("exe" , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
| Some ("path" , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
| Some ("bin" , s) -> add_artifact acc ~var (A.binary s)
| Some ("lib" , s)
| Some ("libexec" , s) ->
let lib_dep, res = A.file_of_lib ~dir s in
add_artifact acc ~var ~lib_dep res
(* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
| Some ("findlib" , s) ->
let lib_dep, res = A.file_of_lib ~dir s ~use_provides:true in
add_artifact acc ~var ~lib_dep res
| _ -> acc)
let expand_var =
let dep_exn name = function
| Some dep -> dep
| None -> die "cannot use ${%s} with files_recursively_in" name
in
fun ~artifacts ~targets ~deps var_name ->
match String_map.find var_name artifacts with
| Some path -> Action.Path path
| None ->
match var_name with
| "@" -> Paths targets
| "<" -> (match deps with
| [] -> Str ""
| dep1 :: _ -> Path (dep_exn var_name dep1))
| "^" ->
Paths (List.map deps ~f:(dep_exn var_name))
| "ROOT" -> Path Path.root
| _ ->
match String_map.find var_name dollar_var_map with
| Some s -> Str s
| _ -> Not_found
let run t ~dir ~dep_kind ~targets ~deps =
let forms = extract_artifacts ~dir t in
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
in
match forms.failures with
| [] -> build
| fail :: _ -> Build.fail fail >>> build
end
(* +-----------------------------------------------------------------+
| Preprocessing stuff |
+-----------------------------------------------------------------+ *)
let pp_fname fn =
match Filename.split_ext fn with
| None -> fn ^ ".pp"
@ -683,6 +799,8 @@ module Gen(P : Params) = struct
else [])
]
let target = String_with_vars.of_string "${@}"
(* Generate rules to build the .pp files and return a new module map where all filenames
point to the .pp files *)
let pped_modules ~dir ~dep_kind ~modules ~preprocess ~preprocessor_deps ~lib_name =
@ -690,18 +808,19 @@ module Gen(P : Params) = struct
String_map.map modules ~f:(fun (m : Module.t) ->
match Preprocess_map.find m.name preprocess with
| No_preprocessing -> m
| Command cmd ->
| Action action ->
pped_module m ~dir ~f:(fun _kind src dst ->
let dir = ctx.build_dir in
add_rule
(preprocessor_deps
>>>
Build.path src
>>>
Build.system ~stdout_to:dst ~dir
~needed_to:"run preprocessor commands"
(sprintf "%s %s" (expand_vars ~dir cmd)
(Filename.quote (Path.reach src ~from:dir)))))
Action_interpret.run
(With_stdout_to (target, action))
~dir:ctx.build_dir
~dep_kind
~targets:[dst]
~deps:[Some src]))
| Pps { pps; flags } ->
let ppx_exe, libs = get_ppx_driver pps ~dir ~dep_kind in
pped_module m ~dir ~f:(fun kind src dst ->
@ -796,7 +915,7 @@ module Gen(P : Params) = struct
add_rule
(Build.path path
>>>
Build.echo (Path.relative dir ".merlin-exists") "");
Build.update_file (Path.relative dir ".merlin-exists") "");
add_rule (
Build.fanout requires (ppx_flags ~dir ~src_dir:remaindir t)
>>^ (fun (libs, ppx_flags) ->
@ -830,7 +949,7 @@ module Gen(P : Params) = struct
|> List.map ~f:(Printf.sprintf "%s\n")
|> String.concat ~sep:"")
>>>
Build.echo_dyn path
Build.update_file_dyn path
)
| _ ->
()
@ -1206,7 +1325,7 @@ module Gen(P : Params) = struct
|> List.map ~f:(fun (m : Module.t) ->
sprintf "module %s = %s\n" m.name (Module.real_unit_name m))
|> String.concat ~sep:"")
>>> Build.echo_dyn (Path.relative dir m.ml_fname)));
>>> Build.update_file_dyn (Path.relative dir m.ml_fname)));
let requires, real_requires =
requires ~dir ~dep_kind ~item:lib.name
@ -1389,124 +1508,6 @@ module Gen(P : Params) = struct
; libname = None
}
(* +-----------------------------------------------------------------+
| User actions |
+-----------------------------------------------------------------+ *)
module Action_interpret : sig
val run
: Action.Mini_shexp.Unexpanded.t
-> dir:Path.t
-> dep_kind:Build.lib_dep_kind
-> targets:Path.t list
-> deps:Dep_conf.t list
-> (unit, Action.t) Build.t
end = struct
module U = Action.Mini_shexp.Unexpanded
type resolved_forms =
{ (* Mapping from ${...} forms to their resolutions *)
artifacts : Path.t String_map.t
; (* Failed resolutions *)
failures : fail list
; (* All "name" for ${lib:name:...} forms *)
lib_deps : String_set.t
}
let add_artifact ?lib_dep acc ~var result =
let lib_deps =
match lib_dep with
| None -> acc.lib_deps
| Some lib -> String_set.add lib acc.lib_deps
in
match result with
| Ok path ->
{ acc with
artifacts = String_map.add acc.artifacts ~key:var ~data:path
; lib_deps
}
| Error fail ->
{ acc with
failures = fail :: acc.failures
; lib_deps
}
let extract_artifacts ~dir t =
let init =
{ artifacts = String_map.empty
; failures = []
; lib_deps = String_set.empty
}
in
U.fold_vars t ~init ~f:(fun acc var ->
let module A = Artifacts in
match String.lsplit2 var ~on:':' with
| Some ("exe" , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
| Some ("path" , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
| Some ("bin" , s) -> add_artifact acc ~var (A.binary s)
| Some ("lib" , s)
| Some ("libexec" , s) ->
let lib_dep, res = A.file_of_lib ~dir s in
add_artifact acc ~var ~lib_dep res
(* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
| Some ("findlib" , s) ->
let lib_dep, res = A.file_of_lib ~dir s ~use_provides:true in
add_artifact acc ~var ~lib_dep res
| _ -> acc)
let expand_var =
let dep_exn name = function
| Some dep -> dep
| None -> die "cannot use ${%s} with files_recursively_in" name
in
fun ~artifacts ~targets ~deps var_name ->
match String_map.find var_name artifacts with
| Some path -> Action.Path path
| None ->
match var_name with
| "@" -> Paths targets
| "<" -> (match deps with
| [] -> Str ""
| dep1 :: _ -> Path (dep_exn var_name dep1))
| "^" ->
Paths (List.map deps ~f:(dep_exn var_name))
| "ROOT" -> Path Path.root
| _ ->
match String_map.find var_name dollar_var_map with
| Some s -> Str s
| _ -> Not_found
let run t ~dir ~dep_kind ~targets ~deps =
let deps =
List.map deps ~f:(fun dep ->
Option.map (Dep_conf_interpret.only_plain_file ~dir dep)
~f:(Path.relative dir))
in
let forms = extract_artifacts ~dir t in
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
in
match forms.failures with
| [] -> build
| fail :: _ -> Build.fail fail >>> build
end
(* +-----------------------------------------------------------------+
| User rules |
+-----------------------------------------------------------------+ *)
@ -1521,7 +1522,7 @@ module Gen(P : Params) = struct
~dir
~dep_kind:Required
~targets
~deps:rule.deps)
~deps:(Dep_conf_interpret.only_plain_files ~dir rule.deps))
let alias_rules (alias_conf : Alias_conf.t) ~dir =
let digest =
@ -1552,7 +1553,7 @@ module Gen(P : Params) = struct
~dir
~dep_kind:Required
~targets:[]
~deps:alias_conf.deps
~deps:(Dep_conf_interpret.only_plain_files ~dir alias_conf.deps)
>>>
Build.and_create_file digest_path)
@ -1772,7 +1773,7 @@ module Gen(P : Params) = struct
Format.pp_print_flush ppf ();
Buffer.contents buf)
>>>
Build.echo_dyn meta_path);
Build.update_file_dyn meta_path);
if has_meta || has_meta_tmpl then
Some pkg.name
@ -1913,7 +1914,7 @@ module Gen(P : Params) = struct
>>^ (fun () ->
Install.gen_install_file entries)
>>>
Build.echo_dyn fn)
Build.update_file_dyn fn)
let () = String_map.iter P.packages ~f:(fun ~key:_ ~data:pkg ->
install_file pkg.Package.path pkg.name)

8
src/jbuild_types.ml
View File

@ -160,14 +160,14 @@ module Preprocess = struct
type pps = { pps : Pp.t list; flags : string list }
type t =
| No_preprocessing
| Command of String_with_vars.t
| Pps of pps
| Action of Action.Mini_shexp.Unexpanded.t
| Pps of pps
let t =
sum
[ cstr "no_preprocessing" nil No_preprocessing
; cstr "command" (String_with_vars.t @> nil) (fun x -> Command x)
; cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
; cstr "action" (Action.Mini_shexp.Unexpanded.t @> nil) (fun x -> Action x)
; cstr "pps" (list Pp_or_flags.t @> nil) (fun l ->
let pps, flags = Pp_or_flags.split l in
Pps { pps; flags })
]