Merge pull request #1014 from diml/refactor-a-bit-gen_rules
Refactor a bit gen rules
This commit is contained in:
commit
66024e72d4
313
src/gen_rules.ml
313
src/gen_rules.ml
|
@ -17,11 +17,6 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
let sctx = P.sctx
|
let sctx = P.sctx
|
||||||
let ctx = SC.context sctx
|
let ctx = SC.context sctx
|
||||||
|
|
||||||
let stanzas_per_dir =
|
|
||||||
List.map (SC.stanzas sctx) ~f:(fun stanzas ->
|
|
||||||
(stanzas.SC.Dir_with_jbuild.ctx_dir, stanzas))
|
|
||||||
|> Path.Map.of_list_exn
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| Interpretation of [modules] fields |
|
| Interpretation of [modules] fields |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
@ -173,176 +168,116 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
mlds
|
mlds
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
(* +-----------------------------------------------------------------+
|
||||||
| User rules & copy files |
|
| Directory contents |
|
||||||
+-----------------------------------------------------------------+ *)
|
+-----------------------------------------------------------------+ *)
|
||||||
|
|
||||||
let interpret_locks ~dir ~scope locks =
|
module Dir_contents : sig
|
||||||
List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope)
|
type t = private
|
||||||
|
{ (* Set of "text" files (.ml, .c, ...). This is
|
||||||
|
the set of source files + user generated ones. *)
|
||||||
|
text_files : String.Set.t
|
||||||
|
; modules : Module.t Module.Name.Map.t Lazy.t
|
||||||
|
; mlds : string String.Map.t Lazy.t
|
||||||
|
}
|
||||||
|
|
||||||
let user_rule (rule : Rule.t) ~dir ~scope =
|
val get : dir:Path.t -> t
|
||||||
let targets : SC.Action.targets =
|
end = struct
|
||||||
match rule.targets with
|
type t =
|
||||||
| Infer -> Infer
|
{ text_files : String.Set.t
|
||||||
| Static fns -> Static (List.map fns ~f:(Path.relative dir))
|
; modules : Module.t Module.Name.Map.t Lazy.t
|
||||||
in
|
; mlds : string String.Map.t Lazy.t
|
||||||
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 =
|
(* As a side-effect, setup user rules and copy_files rules. *)
|
||||||
let loc = String_with_vars.loc def.glob in
|
let load_text_files ~dir =
|
||||||
let glob_in_src =
|
match SC.stanzas_in sctx ~dir with
|
||||||
let src_glob = SC.expand_vars_string sctx ~dir def.glob ~scope in
|
| None -> String.Set.empty
|
||||||
Path.relative src_dir src_glob ~error_loc:loc
|
| Some { stanzas; src_dir; scope; _ } ->
|
||||||
in
|
(* Interpret a few stanzas in order to determine the list of
|
||||||
(* The following condition is required for merlin to work.
|
files generated by the user. *)
|
||||||
Additionally, the order in which the rules are evaluated only
|
let generated_files =
|
||||||
ensures that [sources_and_targets_known_so_far] returns the
|
List.concat_map stanzas ~f:(fun stanza ->
|
||||||
right answer for sub-directories only. *)
|
match (stanza : Stanza.t) with
|
||||||
if not (Path.is_descendant glob_in_src ~of_:src_dir) then
|
| Menhir.T menhir ->
|
||||||
Loc.fail loc "%s is not a sub-directory of %s"
|
Menhir_rules.targets menhir
|
||||||
(Path.to_string_maybe_quoted glob_in_src) (Path.to_string_maybe_quoted src_dir);
|
| Rule rule ->
|
||||||
let glob = Path.basename glob_in_src in
|
List.map (Simple_rules.user_rule sctx rule ~dir ~scope)
|
||||||
let src_in_src = Path.parent_exn glob_in_src in
|
~f:Path.basename
|
||||||
let re =
|
| Copy_files def ->
|
||||||
match Glob_lexer.parse_string glob with
|
List.map (Simple_rules.copy_files sctx def ~src_dir ~dir ~scope)
|
||||||
| Ok re ->
|
~f:Path.basename
|
||||||
Re.compile re
|
| Library { buildable; _ } | Executables { buildable; _ } ->
|
||||||
| Error (_pos, msg) ->
|
(* Manually add files generated by the (select ...)
|
||||||
Loc.fail (String_with_vars.loc def.glob) "invalid glob: %s" msg
|
dependencies *)
|
||||||
in
|
List.filter_map buildable.libraries ~f:(fun dep ->
|
||||||
(* add rules *)
|
match (dep : Jbuild.Lib_dep.t) with
|
||||||
let src_in_build = Path.append ctx.build_dir src_in_src in
|
| Direct _ -> None
|
||||||
let files = SC.eval_glob sctx ~dir:src_in_build re in
|
| Select s -> Some s.result_fn)
|
||||||
List.map files ~f:(fun basename ->
|
| _ -> [])
|
||||||
let file_src = Path.relative src_in_build basename in
|
|> String.Set.of_list
|
||||||
let file_dst = Path.relative dir basename in
|
in
|
||||||
SC.add_rule sctx
|
String.Set.union generated_files
|
||||||
((if def.add_line_directive
|
(SC.source_files sctx ~src_path:src_dir)
|
||||||
then Build.copy_and_add_line_directive
|
|
||||||
else Build.copy)
|
|
||||||
~src:file_src
|
|
||||||
~dst:file_dst);
|
|
||||||
file_dst)
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
let extract_modules ~dir ~files =
|
||||||
| "text" file listing |
|
let make_module syntax base fn =
|
||||||
+-----------------------------------------------------------------+ *)
|
(Module.Name.of_string base,
|
||||||
|
Module.File.make syntax (Path.relative dir fn))
|
||||||
|
in
|
||||||
|
let impl_files, intf_files =
|
||||||
|
String.Set.to_list files
|
||||||
|
|> List.filter_partition_map ~f:(fun fn ->
|
||||||
|
(* we aren't using Filename.extension because we want to handle
|
||||||
|
filenames such as foo.cppo.ml *)
|
||||||
|
match String.lsplit2 fn ~on:'.' with
|
||||||
|
| Some (s, "ml" ) -> Left (make_module OCaml s fn)
|
||||||
|
| Some (s, "re" ) -> Left (make_module Reason s fn)
|
||||||
|
| Some (s, "mli") -> Right (make_module OCaml s fn)
|
||||||
|
| Some (s, "rei") -> Right (make_module Reason s fn)
|
||||||
|
| _ -> Skip)
|
||||||
|
in
|
||||||
|
let parse_one_set (files : (Module.Name.t * Module.File.t) list) =
|
||||||
|
match Module.Name.Map.of_list files with
|
||||||
|
| Ok x -> x
|
||||||
|
| Error (name, f1, f2) ->
|
||||||
|
let src_dir = Path.drop_build_context_exn dir in
|
||||||
|
die "Too many files for module %a in %a:\
|
||||||
|
\n- %a\
|
||||||
|
\n- %a"
|
||||||
|
Module.Name.pp name
|
||||||
|
Path.pp src_dir
|
||||||
|
Path.pp f1.path
|
||||||
|
Path.pp f2.path
|
||||||
|
in
|
||||||
|
let impls = parse_one_set impl_files in
|
||||||
|
let intfs = parse_one_set intf_files in
|
||||||
|
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
||||||
|
Some (Module.make name ?impl ?intf))
|
||||||
|
|
||||||
(* Compute the list of "text" files (.ml, .c, ...). This is the list
|
let extract_mlds ~files =
|
||||||
of source files + user generated ones. As a side-effect, setup
|
String.Set.fold files ~init:String.Map.empty ~f:(fun fn acc ->
|
||||||
user rules and copy_files rules. *)
|
|
||||||
let text_files =
|
|
||||||
let cache = Hashtbl.create 32 in
|
|
||||||
fun ~dir ->
|
|
||||||
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
|
||||||
match Path.Map.find stanzas_per_dir dir with
|
|
||||||
| None -> String.Set.empty
|
|
||||||
| Some { stanzas; src_dir; scope; _ } ->
|
|
||||||
(* Interpret a few stanzas in order to determine the list of
|
|
||||||
files generated by the user. *)
|
|
||||||
let generated_files =
|
|
||||||
List.concat_map stanzas ~f:(fun stanza ->
|
|
||||||
match (stanza : Stanza.t) with
|
|
||||||
| Menhir.T menhir ->
|
|
||||||
Menhir_rules.targets menhir
|
|
||||||
| Rule rule ->
|
|
||||||
List.map (user_rule rule ~dir ~scope) ~f:Path.basename
|
|
||||||
| Copy_files def ->
|
|
||||||
List.map (copy_files_rules def ~src_dir ~dir ~scope)
|
|
||||||
~f:Path.basename
|
|
||||||
| Library { buildable; _ } | Executables { buildable; _ } ->
|
|
||||||
(* Manually add files generated by the (select ...)
|
|
||||||
dependencies *)
|
|
||||||
List.filter_map buildable.libraries ~f:(fun dep ->
|
|
||||||
match (dep : Jbuild.Lib_dep.t) with
|
|
||||||
| Direct _ -> None
|
|
||||||
| Select s -> Some s.result_fn)
|
|
||||||
| _ -> [])
|
|
||||||
|> String.Set.of_list
|
|
||||||
in
|
|
||||||
String.Set.union generated_files
|
|
||||||
(SC.source_files sctx ~src_path:src_dir))
|
|
||||||
|
|
||||||
(* +-----------------------------------------------------------------+
|
|
||||||
| Modules listing |
|
|
||||||
+-----------------------------------------------------------------+ *)
|
|
||||||
|
|
||||||
let guess_modules ~dir ~files =
|
|
||||||
let make_module syntax base fn =
|
|
||||||
(Module.Name.of_string base,
|
|
||||||
Module.File.make syntax (Path.relative dir fn))
|
|
||||||
in
|
|
||||||
let impl_files, intf_files =
|
|
||||||
String.Set.to_list files
|
|
||||||
|> List.filter_partition_map ~f:(fun fn ->
|
|
||||||
(* we aren't using Filename.extension because we want to handle
|
|
||||||
filenames such as foo.cppo.ml *)
|
|
||||||
match String.lsplit2 fn ~on:'.' with
|
match String.lsplit2 fn ~on:'.' with
|
||||||
| Some (s, "ml" ) -> Left (make_module OCaml s fn)
|
| Some (s, "mld") -> String.Map.add acc s fn
|
||||||
| Some (s, "re" ) -> Left (make_module Reason s fn)
|
| _ -> acc)
|
||||||
| Some (s, "mli") -> Right (make_module OCaml s fn)
|
|
||||||
| Some (s, "rei") -> Right (make_module Reason s fn)
|
|
||||||
| _ -> Skip)
|
|
||||||
in
|
|
||||||
let parse_one_set (files : (Module.Name.t * Module.File.t) list) =
|
|
||||||
match Module.Name.Map.of_list files with
|
|
||||||
| Ok x -> x
|
|
||||||
| Error (name, f1, f2) ->
|
|
||||||
let src_dir = Path.drop_build_context_exn dir in
|
|
||||||
die "Too many files for module %a in %a:\
|
|
||||||
\n- %a\
|
|
||||||
\n- %a"
|
|
||||||
Module.Name.pp name
|
|
||||||
Path.pp src_dir
|
|
||||||
Path.pp f1.path
|
|
||||||
Path.pp f2.path
|
|
||||||
in
|
|
||||||
let impls = parse_one_set impl_files in
|
|
||||||
let intfs = parse_one_set intf_files in
|
|
||||||
Module.Name.Map.merge impls intfs ~f:(fun name impl intf ->
|
|
||||||
Some (Module.make name ?impl ?intf))
|
|
||||||
|
|
||||||
let guess_mlds ~files =
|
let get =
|
||||||
String.Set.to_list files
|
let cache = Hashtbl.create 32 in
|
||||||
|> List.filter_map ~f:(fun fn ->
|
fun ~dir ->
|
||||||
match String.lsplit2 fn ~on:'.' with
|
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
||||||
| Some (s, "mld") -> Some (s, fn)
|
let files = load_text_files ~dir in
|
||||||
| _ -> None)
|
{ text_files = files
|
||||||
|> String.Map.of_list_exn
|
; modules = lazy (extract_modules ~dir ~files)
|
||||||
|
; mlds = lazy (extract_mlds ~files)
|
||||||
let mlds_by_dir =
|
})
|
||||||
let cache = Hashtbl.create 32 in
|
end
|
||||||
fun ~dir ->
|
|
||||||
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
|
||||||
let files = text_files ~dir in
|
|
||||||
guess_mlds ~files)
|
|
||||||
|
|
||||||
let mlds_of_dir (doc : Documentation.t) ~dir =
|
let mlds_of_dir (doc : Documentation.t) ~dir =
|
||||||
parse_mlds ~dir
|
parse_mlds ~dir
|
||||||
~all_mlds:(mlds_by_dir ~dir)
|
~all_mlds:(Lazy.force (Dir_contents.get ~dir).mlds)
|
||||||
~mlds_written_by_user:doc.mld_files
|
~mlds_written_by_user:doc.mld_files
|
||||||
|> String.Map.values
|
|> String.Map.values
|
||||||
|> List.map ~f:(Path.relative dir)
|
|> List.map ~f:(Path.relative dir)
|
||||||
|
|
||||||
let modules_by_dir =
|
|
||||||
let cache = Hashtbl.create 32 in
|
|
||||||
fun ~dir ->
|
|
||||||
Hashtbl.find_or_add cache dir ~f:(fun dir ->
|
|
||||||
let files = text_files ~dir in
|
|
||||||
guess_modules ~dir ~files)
|
|
||||||
|
|
||||||
type modules_by_lib =
|
type modules_by_lib =
|
||||||
{ modules : Module.t Module.Name.Map.t
|
{ modules : Module.t Module.Name.Map.t
|
||||||
; alias_module : Module.t option
|
; alias_module : Module.t option
|
||||||
|
@ -353,7 +288,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
let cache = Hashtbl.create 32 in
|
let cache = Hashtbl.create 32 in
|
||||||
fun (lib : Library.t) ~dir ->
|
fun (lib : Library.t) ~dir ->
|
||||||
Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ ->
|
Hashtbl.find_or_add cache (dir, lib.name) ~f:(fun _ ->
|
||||||
let all_modules = modules_by_dir ~dir in
|
let all_modules = Lazy.force (Dir_contents.get ~dir).modules in
|
||||||
let modules =
|
let modules =
|
||||||
parse_modules ~all_modules ~buildable:lib.buildable
|
parse_modules ~all_modules ~buildable:lib.buildable
|
||||||
in
|
in
|
||||||
|
@ -921,44 +856,9 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
~modules_partitioner ~scope ~compile_info ~dir_kind)
|
~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
|
let tests_rules (t : Tests.t) ~dir ~scope ~all_modules ~modules_partitioner
|
||||||
~dir_kind ~src_dir =
|
~dir_kind ~src_dir =
|
||||||
let test_kind (loc, name) =
|
let test_kind (loc, name) =
|
||||||
|
@ -1011,12 +911,13 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
} in
|
} in
|
||||||
match test_kind (loc, s) with
|
match test_kind (loc, s) with
|
||||||
| `Regular ->
|
| `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 ->
|
| `Expect diff ->
|
||||||
let (alias, rule) =
|
let (alias, rule) =
|
||||||
expect_rule run_action diff base_alias loc in
|
expect_rule run_action diff base_alias loc in
|
||||||
alias_rules ~dir ~scope alias;
|
Simple_rules.alias sctx alias ~dir ~scope;
|
||||||
ignore (user_rule ~dir ~scope rule : Path.t list));
|
ignore (Simple_rules.user_rule sctx rule ~dir ~scope : Path.t list));
|
||||||
executables_rules t.exes ~dir ~all_modules ~scope ~dir_kind
|
executables_rules t.exes ~dir ~all_modules ~scope ~dir_kind
|
||||||
~modules_partitioner
|
~modules_partitioner
|
||||||
|
|
||||||
|
@ -1026,8 +927,12 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
|
|
||||||
let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
|
let gen_rules { SC.Dir_with_jbuild. src_dir; ctx_dir; stanzas; scope; kind } =
|
||||||
(* This interprets "rule" and "copy_files" stanzas. *)
|
(* This interprets "rule" and "copy_files" stanzas. *)
|
||||||
let files = text_files ~dir:ctx_dir in
|
let { Dir_contents.
|
||||||
let all_modules = modules_by_dir ~dir:ctx_dir in
|
text_files = files
|
||||||
|
; modules = lazy all_modules
|
||||||
|
; mlds = _
|
||||||
|
} = Dir_contents.get ~dir:ctx_dir
|
||||||
|
in
|
||||||
let modules_partitioner = Modules_partitioner.create ~dir_kind:kind in
|
let modules_partitioner = Modules_partitioner.create ~dir_kind:kind in
|
||||||
let merlins =
|
let merlins =
|
||||||
List.filter_map stanzas ~f:(fun stanza ->
|
List.filter_map stanzas ~f:(fun stanza ->
|
||||||
|
@ -1040,7 +945,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
Some (executables_rules exes ~dir ~all_modules ~scope
|
Some (executables_rules exes ~dir ~all_modules ~scope
|
||||||
~modules_partitioner ~dir_kind:kind)
|
~modules_partitioner ~dir_kind:kind)
|
||||||
| Alias alias ->
|
| Alias alias ->
|
||||||
alias_rules alias ~dir ~scope;
|
Simple_rules.alias sctx alias ~dir ~scope;
|
||||||
None
|
None
|
||||||
| Tests tests ->
|
| Tests tests ->
|
||||||
Some (tests_rules tests ~dir ~scope ~all_modules ~src_dir
|
Some (tests_rules tests ~dir ~scope ~all_modules ~src_dir
|
||||||
|
@ -1096,7 +1001,7 @@ module Gen(P : Install_rules.Params) = struct
|
||||||
| "_doc" :: rest -> Odoc.gen_rules rest ~dir
|
| "_doc" :: rest -> Odoc.gen_rules rest ~dir
|
||||||
| ".ppx" :: rest -> Preprocessing.gen_rules sctx rest
|
| ".ppx" :: rest -> Preprocessing.gen_rules sctx rest
|
||||||
| _ ->
|
| _ ->
|
||||||
match Path.Map.find stanzas_per_dir dir with
|
match SC.stanzas_in sctx ~dir with
|
||||||
| Some x -> gen_rules x
|
| Some x -> gen_rules x
|
||||||
| None ->
|
| None ->
|
||||||
if components <> [] &&
|
if components <> [] &&
|
||||||
|
|
|
@ -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
|
|
@ -40,6 +40,7 @@ type t =
|
||||||
; public_libs : Lib.DB.t
|
; public_libs : Lib.DB.t
|
||||||
; installed_libs : Lib.DB.t
|
; installed_libs : Lib.DB.t
|
||||||
; stanzas : Dir_with_jbuild.t list
|
; stanzas : Dir_with_jbuild.t list
|
||||||
|
; stanzas_per_dir : Dir_with_jbuild.t Path.Map.t
|
||||||
; packages : Package.t Package.Name.Map.t
|
; packages : Package.t Package.Name.Map.t
|
||||||
; file_tree : File_tree.t
|
; file_tree : File_tree.t
|
||||||
; artifacts : Artifacts.t
|
; artifacts : Artifacts.t
|
||||||
|
@ -55,6 +56,7 @@ type t =
|
||||||
|
|
||||||
let context t = t.context
|
let context t = t.context
|
||||||
let stanzas t = t.stanzas
|
let stanzas t = t.stanzas
|
||||||
|
let stanzas_in t ~dir = Path.Map.find t.stanzas_per_dir dir
|
||||||
let packages t = t.packages
|
let packages t = t.packages
|
||||||
let libs_by_package t = t.libs_by_package
|
let libs_by_package t = t.libs_by_package
|
||||||
let artifacts t = t.artifacts
|
let artifacts t = t.artifacts
|
||||||
|
@ -248,6 +250,11 @@ let create
|
||||||
; kind
|
; kind
|
||||||
})
|
})
|
||||||
in
|
in
|
||||||
|
let stanzas_per_dir =
|
||||||
|
List.map stanzas ~f:(fun stanzas ->
|
||||||
|
(stanzas.Dir_with_jbuild.ctx_dir, stanzas))
|
||||||
|
|> Path.Map.of_list_exn
|
||||||
|
in
|
||||||
let stanzas_to_consider_for_install =
|
let stanzas_to_consider_for_install =
|
||||||
if not external_lib_deps_mode then
|
if not external_lib_deps_mode then
|
||||||
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
List.concat_map stanzas ~f:(fun { ctx_dir; stanzas; scope; kind; _ } ->
|
||||||
|
@ -305,6 +312,7 @@ let create
|
||||||
; public_libs
|
; public_libs
|
||||||
; installed_libs
|
; installed_libs
|
||||||
; stanzas
|
; stanzas
|
||||||
|
; stanzas_per_dir
|
||||||
; packages
|
; packages
|
||||||
; file_tree
|
; file_tree
|
||||||
; stanzas_to_consider_for_install
|
; stanzas_to_consider_for_install
|
||||||
|
|
|
@ -43,6 +43,7 @@ val create
|
||||||
|
|
||||||
val context : t -> Context.t
|
val context : t -> Context.t
|
||||||
val stanzas : t -> Dir_with_jbuild.t list
|
val stanzas : t -> Dir_with_jbuild.t list
|
||||||
|
val stanzas_in : t -> dir:Path.t -> Dir_with_jbuild.t option
|
||||||
val packages : t -> Package.t Package.Name.Map.t
|
val packages : t -> Package.t Package.Name.Map.t
|
||||||
val libs_by_package : t -> (Package.t * Lib.Set.t) Package.Name.Map.t
|
val libs_by_package : t -> (Package.t * Lib.Set.t) Package.Name.Map.t
|
||||||
val file_tree : t -> File_tree.t
|
val file_tree : t -> File_tree.t
|
||||||
|
|
Loading…
Reference in New Issue