From b6108d70917be471d0e71cc10efb67e218f377c5 Mon Sep 17 00:00:00 2001 From: Jeremie Dimino Date: Thu, 12 Jul 2018 17:14:02 +0100 Subject: [PATCH] Move a few functions from gen_rules.ml to simple_rules.ml Signed-off-by: Jeremie Dimino --- src/gen_rules.ml | 115 ++++--------------------------------------- src/simple_rules.ml | 101 +++++++++++++++++++++++++++++++++++++ src/simple_rules.mli | 29 +++++++++++ 3 files changed, 139 insertions(+), 106 deletions(-) create mode 100644 src/simple_rules.ml create mode 100644 src/simple_rules.mli diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 4ff3e069..2b9e399e 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -172,70 +172,6 @@ module Gen(P : Install_rules.Params) = struct ~standard:all_mlds in mlds - (* +-----------------------------------------------------------------+ - | User rules & copy files | - +-----------------------------------------------------------------+ *) - - let interpret_locks ~dir ~scope locks = - List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope) - - let user_rule (rule : Rule.t) ~dir ~scope = - let targets : SC.Action.targets = - match rule.targets with - | Infer -> Infer - | Static fns -> Static (List.map fns ~f:(Path.relative dir)) - in - SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc - ~locks:(interpret_locks ~dir ~scope rule.locks) - (SC.Deps.interpret_named sctx ~scope ~dir rule.deps - >>> - SC.Action.run - sctx - (snd rule.action) - ~loc:(fst rule.action) - ~dir - ~bindings:(Pform.Map.of_bindings rule.deps) - ~dep_kind:Required - ~targets - ~targets_dir:dir - ~scope) - - let copy_files_rules (def: Copy_files.t) ~src_dir ~dir ~scope = - let loc = String_with_vars.loc def.glob in - let glob_in_src = - let src_glob = SC.expand_vars_string sctx ~dir def.glob ~scope in - Path.relative src_dir src_glob ~error_loc:loc - in - (* The following condition is required for merlin to work. - Additionally, the order in which the rules are evaluated only - ensures that [sources_and_targets_known_so_far] returns the - right answer for sub-directories only. *) - if not (Path.is_descendant glob_in_src ~of_:src_dir) then - Loc.fail loc "%s is not a sub-directory of %s" - (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir); - let glob = Path.basename glob_in_src in - let src_in_src = Path.parent_exn glob_in_src in - let re = - match Glob_lexer.parse_string glob with - | Ok re -> - Re.compile re - | Error (_pos, msg) -> - Loc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg - in - (* add rules *) - let src_in_build = Path.append ctx.build_dir src_in_src in - let files = SC.eval_glob sctx ~dir:src_in_build re in - List.map files ~f:(fun basename -> - let file_src = Path.relative src_in_build basename in - let file_dst = Path.relative dir basename in - SC.add_rule sctx - ((if def.add_line_directive - then Build.copy_and_add_line_directive - else Build.copy) - ~src:file_src - ~dst:file_dst); - file_dst) - (* +-----------------------------------------------------------------+ | Directory contents | +-----------------------------------------------------------------+ *) @@ -270,9 +206,10 @@ module Gen(P : Install_rules.Params) = struct | Menhir.T menhir -> Menhir_rules.targets menhir | Rule rule -> - List.map (user_rule rule ~dir ~scope) ~f:Path.basename + List.map (Simple_rules.user_rule sctx rule ~dir ~scope) + ~f:Path.basename | Copy_files def -> - List.map (copy_files_rules def ~src_dir ~dir ~scope) + List.map (Simple_rules.copy_files sctx def ~src_dir ~dir ~scope) ~f:Path.basename | Library { buildable; _ } | Executables { buildable; _ } -> (* Manually add files generated by the (select ...) @@ -924,44 +861,9 @@ module Gen(P : Install_rules.Params) = struct ~modules_partitioner ~scope ~compile_info ~dir_kind) (* +-----------------------------------------------------------------+ - | Aliases | + | Tests | +-----------------------------------------------------------------+ *) - let add_alias ~dir ~name ~stamp ?(locks=[]) build = - let alias = Build_system.Alias.make name ~dir in - SC.add_alias_action sctx alias ~locks ~stamp build - - let alias_rules (alias_conf : Alias_conf.t) ~dir ~scope = - let stamp = - let module S = Sexp.To_sexp in - Sexp.List - [ Sexp.unsafe_atom_of_string "user-alias" - ; Jbuild.Bindings.sexp_of_t Jbuild.Dep_conf.sexp_of_t alias_conf.deps - ; S.option Action.Unexpanded.sexp_of_t - (Option.map alias_conf.action ~f:snd) - ] - in - add_alias - ~dir - ~name:alias_conf.name - ~stamp - ~locks:(interpret_locks ~dir ~scope alias_conf.locks) - (SC.Deps.interpret_named sctx ~scope ~dir alias_conf.deps - >>> - match alias_conf.action with - | None -> Build.progn [] - | Some (loc, action) -> - SC.Action.run - sctx - action - ~loc - ~dir - ~dep_kind:Required - ~bindings:(Pform.Map.of_bindings alias_conf.deps) - ~targets:Alias - ~targets_dir:dir - ~scope) - let tests_rules (t : Tests.t) ~dir ~scope ~all_modules ~modules_partitioner ~dir_kind ~src_dir = let test_kind (loc, name) = @@ -1014,12 +916,13 @@ module Gen(P : Install_rules.Params) = struct } in match test_kind (loc, s) with | `Regular -> - alias_rules ~dir ~scope (regular_rule run_action base_alias loc) + Simple_rules.alias sctx ~dir ~scope + (regular_rule run_action base_alias loc) | `Expect diff -> let (alias, rule) = expect_rule run_action diff base_alias loc in - alias_rules ~dir ~scope alias; - ignore (user_rule ~dir ~scope rule : Path.t list)); + Simple_rules.alias sctx alias ~dir ~scope; + ignore (Simple_rules.user_rule sctx rule ~dir ~scope : Path.t list)); executables_rules t.exes ~dir ~all_modules ~scope ~dir_kind ~modules_partitioner @@ -1047,7 +950,7 @@ module Gen(P : Install_rules.Params) = struct Some (executables_rules exes ~dir ~all_modules ~scope ~modules_partitioner ~dir_kind:kind) | Alias alias -> - alias_rules alias ~dir ~scope; + Simple_rules.alias sctx alias ~dir ~scope; None | Tests tests -> Some (tests_rules tests ~dir ~scope ~all_modules ~src_dir diff --git a/src/simple_rules.ml b/src/simple_rules.ml new file mode 100644 index 00000000..96fd9fc9 --- /dev/null +++ b/src/simple_rules.ml @@ -0,0 +1,101 @@ +open Import +open Jbuild +open Build.O +open! No_io + +module SC = Super_context + +let interpret_locks sctx ~dir ~scope locks = + List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope) + +let user_rule sctx ~dir ~scope (rule : Rule.t) = + let targets : SC.Action.targets = + match rule.targets with + | Infer -> Infer + | Static fns -> Static (List.map fns ~f:(Path.relative dir)) + in + SC.add_rule_get_targets sctx ~mode:rule.mode ~loc:rule.loc + ~locks:(interpret_locks sctx ~dir ~scope rule.locks) + (SC.Deps.interpret_named sctx ~scope ~dir rule.deps + >>> + SC.Action.run + sctx + (snd rule.action) + ~loc:(fst rule.action) + ~dir + ~bindings:(Pform.Map.of_bindings rule.deps) + ~dep_kind:Required + ~targets + ~targets_dir:dir + ~scope) + +let copy_files sctx ~dir ~scope ~src_dir (def: Copy_files.t) = + let loc = String_with_vars.loc def.glob in + let glob_in_src = + let src_glob = SC.expand_vars_string sctx ~dir def.glob ~scope in + Path.relative src_dir src_glob ~error_loc:loc + in + (* The following condition is required for merlin to work. + Additionally, the order in which the rules are evaluated only + ensures that [sources_and_targets_known_so_far] returns the + right answer for sub-directories only. *) + if not (Path.is_descendant glob_in_src ~of_:src_dir) then + Loc.fail loc "%s is not a sub-directory of %s" + (Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir); + let glob = Path.basename glob_in_src in + let src_in_src = Path.parent_exn glob_in_src in + let re = + match Glob_lexer.parse_string glob with + | Ok re -> + Re.compile re + | Error (_pos, msg) -> + Loc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg + in + (* add rules *) + let src_in_build = Path.append (SC.context sctx).build_dir src_in_src in + let files = SC.eval_glob sctx ~dir:src_in_build re in + List.map files ~f:(fun basename -> + let file_src = Path.relative src_in_build basename in + let file_dst = Path.relative dir basename in + SC.add_rule sctx + ((if def.add_line_directive + then Build.copy_and_add_line_directive + else Build.copy) + ~src:file_src + ~dst:file_dst); + file_dst) + +let add_alias sctx ~dir ~name ~stamp ?(locks=[]) build = + let alias = Build_system.Alias.make name ~dir in + SC.add_alias_action sctx alias ~locks ~stamp build + +let alias sctx ~dir ~scope (alias_conf : Alias_conf.t) = + let stamp = + let module S = Sexp.To_sexp in + Sexp.List + [ Sexp.unsafe_atom_of_string "user-alias" + ; Jbuild.Bindings.sexp_of_t Jbuild.Dep_conf.sexp_of_t alias_conf.deps + ; S.option Action.Unexpanded.sexp_of_t + (Option.map alias_conf.action ~f:snd) + ] + in + add_alias sctx + ~dir + ~name:alias_conf.name + ~stamp + ~locks:(interpret_locks sctx ~dir ~scope alias_conf.locks) + (SC.Deps.interpret_named sctx ~scope ~dir alias_conf.deps + >>> + match alias_conf.action with + | None -> Build.progn [] + | Some (loc, action) -> + SC.Action.run + sctx + action + ~loc + ~dir + ~dep_kind:Required + ~bindings:(Pform.Map.of_bindings alias_conf.deps) + ~targets:Alias + ~targets_dir:dir + ~scope) diff --git a/src/simple_rules.mli b/src/simple_rules.mli new file mode 100644 index 00000000..1a40a90a --- /dev/null +++ b/src/simple_rules.mli @@ -0,0 +1,29 @@ +(** Simple rules: user, copy_files, alias *) + +open Import +open Jbuild + +(** Interpret a [(rule ...)] stanza and return the targets it produces. *) +val user_rule + : Super_context.t + -> dir:Path.t + -> scope:Scope.t + -> Rule.t + -> Path.t list + +(** Interpret a [(copy_files ...)] stanza and return the targets it produces. *) +val copy_files + : Super_context.t + -> dir:Path.t + -> scope:Scope.t + -> src_dir:Path.t + -> Copy_files.t + -> Path.t list + +(** Interpret an [(alias ...)] stanza. *) +val alias + : Super_context.t + -> dir:Path.t + -> scope:Scope.t + -> Alias_conf.t + -> unit