From d3410e0659557e8861f5c2ed4ff858029ebfb4fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= Date: Sat, 13 Jan 2018 19:44:06 +0800 Subject: [PATCH] Refactor alias handling * Improve documentation of alias module * Add add_alias helper function to help create rules in alias --- src/alias.ml | 32 ++++++++++++++++---------- src/alias.mli | 39 ++++++++++++++++++-------------- src/gen_rules.ml | 54 ++++++++++++++++++++++++-------------------- src/super_context.ml | 48 ++++++++++++++++----------------------- 4 files changed, 90 insertions(+), 83 deletions(-) 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