Move a few functions from gen_rules.ml to simple_rules.ml
Signed-off-by: Jeremie Dimino <jeremie@dimino.org>
This commit is contained in:
parent
5974be475a
commit
b6108d7091
115
src/gen_rules.ml
115
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
|
||||
|
|
|
@ -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)
|
|
@ -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
|
Loading…
Reference in New Issue