diff --git a/src/action.ml b/src/action.ml index 990bbe5d..1bc05e48 100644 --- a/src/action.ml +++ b/src/action.ml @@ -93,6 +93,29 @@ struct | Remove_tree x -> List [Atom "remove-tree"; path x] | Mkdir x -> List [Atom "mkdir"; path x] | Digest_files paths -> List [Atom "digest-files"; List (List.map paths ~f:path)] + + let run prog args = Run (prog, args) + let chdir path t = Chdir (path, t) + let setenv var value t = Setenv (var, value, t) + let with_stdout_to path t = Redirect (Stdout, path, t) + let with_stderr_to path t = Redirect (Stderr, path, t) + let with_outputs_to path t = Redirect (Outputs, path, t) + let ignore_stdout t = Ignore (Stdout, t) + let ignore_stderr t = Ignore (Stderr, t) + let ignore_outputs t = Ignore (Outputs, t) + let progn ts = Progn ts + let echo s = Echo s + let cat path = Cat path + let copy a b = Copy (a, b) + let symlink a b = Symlink (a, b) + let copy_and_add_line_directive a b = Copy_and_add_line_directive (a, b) + let system s = System s + let bash s = Bash s + let write_file p s = Write_file (p, s) + let rename a b = Rename (a, b) + let remove_tree path = Remove_tree path + let mkdir path = Mkdir path + let digest_files files = Digest_files files end module Make_mapper @@ -534,7 +557,7 @@ type exec_context = ; env : string array } -let run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args = +let exec_run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args = begin match ectx.context with | None | Some { Context.for_host = None; _ } -> () @@ -567,7 +590,7 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = | Run (Error e, _) -> Prog.Not_found.raise e | Run (Ok prog, args) -> - run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args + exec_run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args | Chdir (dir, t) -> exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to | Setenv (var, value, t) -> @@ -633,9 +656,9 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = let path, arg = Utils.system_shell_exn ~needed_to:"interpret (system ...) actions" in - run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to path [arg; cmd] + exec_run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to path [arg; cmd] | Bash cmd -> - run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to + exec_run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to (Utils.bash_exn ~needed_to:"interpret (bash ...) actions") ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] | Write_file (fn, s) -> diff --git a/src/action.mli b/src/action.mli index 12fbcb9c..92da5758 100644 --- a/src/action.mli +++ b/src/action.mli @@ -35,6 +35,12 @@ include Action_intf.Ast with type path := Path.t with type string := string +include Action_intf.Helpers + with type program := Prog.t + with type path := Path.t + with type string := string + with type t := t + val t : t Sexp.Of_sexp.t val sexp_of_t : t Sexp.To_sexp.t diff --git a/src/action_intf.ml b/src/action_intf.ml index 01c76026..b2039448 100644 --- a/src/action_intf.ml +++ b/src/action_intf.ml @@ -31,3 +31,29 @@ module type Ast = sig | Digest_files of path list end +module type Helpers = sig + include Ast + + val run : program -> string list -> t + val chdir : path -> t -> t + val setenv : string -> string -> t -> t + val with_stdout_to : path -> t -> t + val with_stderr_to : path -> t -> t + val with_outputs_to : path -> t -> t + val ignore_stdout : t -> t + val ignore_stderr : t -> t + val ignore_outputs : t -> t + val progn : t list -> t + val echo : string -> t + val cat : path -> t + val copy : path -> path -> t + val symlink : path -> path -> t + val copy_and_add_line_directive : path -> path -> t + val system : string -> t + val bash : string -> t + val write_file : path -> string -> t + val rename : path -> path -> t + val remove_tree : path -> t + val mkdir : path -> t + val digest_files : path list -> t +end diff --git a/src/alias.ml b/src/alias.ml index 5683e4a0..366eb4bc 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -185,18 +185,26 @@ let rules store = in rule :: acc) -let add_stamp_dep (store: Store.t) (t : t) ~data = - let digest = Digest.string (Sexp.to_string data) in +let add_build store t ~stamp build = + let digest = Digest.string (Sexp.to_string stamp) in let digest_path = file_with_digest_suffix t ~digest in add_deps store t [digest_path]; - digest_path + Build.progn + [ build + ; Build.create_file digest_path + ] -let add_action_dep (store: Store.t) (t : t) ~action ~action_deps = - let data = - let deps = Sexp.To_sexp.list Jbuild.Dep_conf.sexp_of_t action_deps in - let action = - match action with - | None -> Sexp.Atom "none" - | Some a -> List [Atom "some"; Action.Unexpanded.sexp_of_t a] in - Sexp.List [deps ; action] in - add_stamp_dep store t ~data +let add_builds store t builds = + let digest_files, actions = + List.split + (List.map builds ~f:(fun (stamp, build) -> + let digest = Digest.string (Sexp.to_string stamp) in + let digest_path = file_with_digest_suffix t ~digest in + (digest_path, + Build.progn + [ build + ; Build.create_file digest_path + ]))) + in + add_deps store t digest_files; + actions diff --git a/src/alias.mli b/src/alias.mli index da5337f7..35a006df 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -67,24 +67,29 @@ module Store : sig val unlink : t -> string list -> unit end +(** [add_build store alias deps] arrange things so that all [deps] are built as part of + the build of alias [alias]. *) val add_deps : Store.t -> t -> Path.t list -> unit +(** [add_build store alias ~stamp build] arrange things so that [build] is part of the + build of alias [alias]. [stamp] is any S-expression that is unique and persistent + S-expression. + + Return a rule that must be added with [Super_context.add_rule]. +*) +val add_build + : Store.t + -> t + -> stamp:Sexp.t + -> (unit, Action.t) Build.t + -> (unit, Action.t) Build.t + +(** Same as calling [add_build] in a loop but slightly more efficient. *) +val add_builds + : Store.t + -> t + -> (Sexp.t * (unit, Action.t) Build.t) list + -> (unit, Action.t) Build.t list + val rules : Store.t -> Build_interpret.Rule.t list -(** Create an alias dependency for an action and its inputs represented by - [~data]. The path returned is the file that should be represented by the - file the action will create following execution.*) -val add_stamp_dep - : Store.t - -> t - -> data:Sexp.t - -> Path.t - -(** Like [add_stamp_dep] but an action (if present) and the dependencies can be - passed in directly. *) -val add_action_dep - : Store.t - -> t - -> action:Action.Unexpanded.t option - -> action_deps:Jbuild.Dep_conf.t list - -> Path.t diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 5aed08cc..e0e699d4 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -283,7 +283,7 @@ module Gen(P : Params) = struct Option.iter alias_module ~f:(fun m -> let flags = Ocaml_flags.default () in Module_compilation.build_module sctx m - ~js_of_ocaml + ~js_of_ocaml ~dynlink ~sandbox:alias_module_build_sandbox ~flags:(Ocaml_flags.append_common flags ["-w"; "-49"]) @@ -573,33 +573,37 @@ module Gen(P : Params) = struct ~targets ~scope) + let add_alias ~dir ~name ~stamp ?(locks=[]) build = + let alias = Alias.make name ~dir in + SC.add_rule sctx ~locks + (Alias.add_build (SC.aliases sctx) alias ~stamp build) + let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope = - let alias = Alias.make alias_conf.name ~dir in - let digest_path = - Alias.add_action_dep (SC.aliases sctx) alias - ~action:alias_conf.action - ~action_deps:alias_conf.deps in - let deps = SC.Deps.interpret sctx ~scope ~dir alias_conf.deps in - SC.add_rule sctx + let stamp = + let module S = Sexp.To_sexp in + Sexp.List + [ Atom "user-alias" + ; S.list Jbuild.Dep_conf.sexp_of_t alias_conf.deps + ; S.option Action.Unexpanded.sexp_of_t alias_conf.action + ] + in + add_alias + ~dir + ~name:alias_conf.name + ~stamp ~locks:(interpret_locks ~dir ~scope alias_conf.locks) - (match alias_conf.action with - | None -> - deps - >>> - Build.create_file digest_path + (SC.Deps.interpret sctx ~scope ~dir alias_conf.deps + >>> + match alias_conf.action with + | None -> Build.progn [] | Some action -> - deps - >>> - Build.progn - [ SC.Action.run - sctx - action - ~dir - ~dep_kind:Required - ~targets:(Static []) - ~scope - ; Build.create_file digest_path - ]) + SC.Action.run + sctx + action + ~dir + ~dep_kind:Required + ~targets:(Static []) + ~scope) let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope = let loc = String_with_vars.loc def.glob in diff --git a/src/super_context.ml b/src/super_context.ml index 60baffbc..f4837bc3 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -892,30 +892,28 @@ module PP = struct let lint_module sctx ~(source : Module.t) ~(ast : Module.t) ~dir ~dep_kind ~lint ~lib_name ~scope = let alias = Alias.lint ~dir in + let add_alias fn build = + add_rule sctx + (Alias.add_build (aliases sctx) alias build + ~stamp:(List [ Atom "lint" + ; Sexp.To_sexp.(option string) lib_name + ; Atom fn])) + in match Preprocess_map.find source.name lint with | No_preprocessing -> () | Action action -> let action = Action.U.Chdir (root_var, action) in Module.iter source ~f:(fun _ (src : Module.File.t) -> - let digest_path = - Alias.add_action_dep - ~action:(Some action) - ~action_deps:[Dep_conf.File (String_with_vars.virt __POS__ src.name)] - (aliases sctx) alias in - let src = Path.relative dir src.name in - add_rule sctx - (Build.path src - >>^ (fun _ -> [src]) - >>> - Build.progn - [ Action.run sctx + let src_path = Path.relative dir src.name in + add_alias src.name + (Build.path src_path + >>^ (fun _ -> [src_path]) + >>> Action.run sctx action ~dir ~dep_kind ~targets:(Static []) - ~scope - ; Build.create_file digest_path - ]) + ~scope) ) | Pps { pps; flags } -> let ppx_exe = get_ppx_driver sctx pps ~dir ~dep_kind in @@ -926,25 +924,17 @@ module PP = struct ; As (cookie_library_name lib_name) ; Ml_kind.ppx_driver_flag kind ; Dep src_path - ] in + ] + in let args = (* This hack is needed until -null is standard: https://github.com/ocaml-ppx/ocaml-migrate-parsetree/issues/35 *) match Option.map ~f:Pp.to_string (List.last pps) with | Some "ppx_driver.runner" -> args @ [A "-null"] - | Some _ | None -> args in - let digest_path = - Alias.add_stamp_dep (aliases sctx) alias - ~data:( - Sexp.To_sexp.( - triple Path.sexp_of_t string (pair (list string) Path.Set.sexp_of_t) - ) (ppx_exe, src.name, Arg_spec.expand ~dir args ()) - ) in - add_rule sctx - (Build.progn - [ Build.run ~context:sctx.context (Ok ppx_exe) args - ; Build.create_file digest_path - ]) + | Some _ | None -> args + in + add_alias src.name + (Build.run ~context:sctx.context (Ok ppx_exe) args) ) (* Generate rules to build the .pp files and return a new module map where all filenames