Skip to content

Commit

Permalink
Add (includes ((sub_dirs (...)))) stanza
Browse files Browse the repository at this point in the history
  • Loading branch information
@bobot
bobot committed Mar 22, 2017
1 parent 223669b commit 2d1659d
Show file tree
Hide file tree
Showing 4 changed files with 124 additions and 77 deletions.
133 changes: 75 additions & 58 deletions src/gen_rules.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,8 +71,8 @@ end
let default_c_flags = g ()
let default_cxx_flags = g ()

let cm_files modules ~dir ~cm_kind =
List.map modules ~f:(fun (m : Module.t) -> Module.cm_file m ~dir cm_kind)
let cm_files modules ~cm_kind =
List.map modules ~f:(fun (m : Module.t) -> Module.cm_file m cm_kind)

let find_module ~dir modules name =
String_map.find_exn name modules
Expand All @@ -89,9 +89,10 @@ let modules_of_names ~dir ~modules names =
List.map names ~f:(find_module ~dir modules)

let obj_name_of_basename fn =
match String.index fn '.' with
let base = Path.basename fn in
match String.index base '.' with
| None -> fn
| Some i -> String.sub fn ~pos:0 ~len:i
| Some i -> Path.relative (Path.parent fn) (String.sub base ~pos:0 ~len:i)

module type Params = sig
val context : Context.t
Expand Down Expand Up @@ -502,7 +503,7 @@ module Gen(P : Params) = struct
Build.Vspec.T (fn, (module Ocamldep_vfile))
in
let files =
List.filter_map (String_map.values modules) ~f:(fun m -> Module.file ~dir m ml_kind)
List.filter_map (String_map.values modules) ~f:(fun m -> Module.file m ml_kind)
|> List.map ~f:(fun fn ->
match ml_kind, Filename.ext (Path.to_string fn) with
| Impl, Some ".ml" -> Arg_spec.Dep fn
Expand Down Expand Up @@ -539,7 +540,7 @@ module Gen(P : Params) = struct
let names_to_top_closed_cm_files ~dir ~dep_graph ~modules ~mode names =
dep_closure ~dir dep_graph names
|> modules_of_names ~dir ~modules
|> cm_files ~dir ~cm_kind:(Mode.cm_kind mode)
|> cm_files ~cm_kind:(Mode.cm_kind mode)


let ocamldep_rules ~dir ~item ~modules ~alias_module =
Expand Down Expand Up @@ -670,15 +671,15 @@ module Gen(P : Params) = struct
[foo.pp.mli] is the interface for [foo.pp.ml] *)
fn ^ ".pp" ^ ext

let pped_module ~dir (m : Module.t) ~f =
let ml_pp_fname = pp_fname m.ml_fname in
f Ml_kind.Impl (Path.relative dir m.ml_fname) (Path.relative dir ml_pp_fname);
let mli_pp_fname =
Option.map m.mli_fname ~f:(fun fname ->
let pp_fname = pp_fname fname in
f Intf (Path.relative dir fname) (Path.relative dir pp_fname);
pp_fname)
let pped_module (m : Module.t) ~f =
let pp_of_source (kind:Ml_kind.t) fname =
let dir = Path.parent fname in
let pp_fname = (Path.relative dir (pp_fname (Path.basename m.ml_fname))) in
f kind fname pp_fname;
pp_fname
in
let ml_pp_fname = pp_of_source Impl m.ml_fname in
let mli_pp_fname = Option.map m.mli_fname ~f:(pp_of_source Intf) in
{ m with
ml_fname = ml_pp_fname
; mli_fname = mli_pp_fname
Expand Down Expand Up @@ -823,7 +824,7 @@ module Gen(P : Params) = struct
match Preprocess_map.find m.name preprocess with
| No_preprocessing -> m
| Action action ->
pped_module m ~dir ~f:(fun _kind src dst ->
pped_module m ~f:(fun _kind src dst ->
add_rule
(preprocessor_deps
>>>
Expand All @@ -841,7 +842,7 @@ module Gen(P : Params) = struct
~deps:[Some src]))
| Pps { pps; flags } ->
let ppx_exe, libs = get_ppx_driver pps ~dir ~dep_kind in
pped_module m ~dir ~f:(fun kind src dst ->
pped_module m ~f:(fun kind src dst ->
add_rule
(preprocessor_deps
>>>
Expand Down Expand Up @@ -1051,34 +1052,34 @@ module Gen(P : Params) = struct
let build_cm ~flags ~cm_kind ~dep_graph ~requires
~(modules : Module.t String_map.t) ~dir ~alias_module (m : Module.t) =
Option.iter (Cm_kind.compiler cm_kind) ~f:(fun compiler ->
Option.iter (Module.cm_source ~dir m cm_kind) ~f:(fun src ->
Option.iter (Module.cm_source m cm_kind) ~f:(fun src ->
let ml_kind = Cm_kind.source cm_kind in
let dst = Module.cm_file m ~dir cm_kind in
let dst = Module.cm_file m cm_kind in
let extra_args, extra_deps, extra_targets =
match cm_kind, m.mli_fname with
(* If there is no mli, [ocamlY -c file.ml] produces both the
.cmY and .cmi. We choose to use ocamlc to produce the cmi
and to produce the cmx we have to wait to avoid race
conditions. *)
| Cmo, None -> [], [], [Module.cm_file m ~dir Cmi]
| Cmo, None -> [], [], [Module.cm_file m Cmi]
| Cmx, None ->
(* Change [-intf-suffix] so that the compiler thinks the
cmi exists and reads it instead of re-creating it, which
could create a race condition. *)
([ "-intf-suffix"
; match Filename.ext m.ml_fname with
; match Filename.ext (Path.basename m.ml_fname) with
| None -> ""
| Some ext -> ext
],
[Module.cm_file m ~dir Cmi], [])
[Module.cm_file m Cmi], [])
| Cmi, None -> assert false
| Cmi, Some _ -> [], [], []
(* We need the .cmi to build either the .cmo or .cmx *)
| (Cmo | Cmx), Some _ -> [], [Module.cm_file m ~dir Cmi], []
| (Cmo | Cmx), Some _ -> [], [Module.cm_file m Cmi], []
in
let extra_targets =
match cm_kind with
| Cmx -> Path.relative dir (m.obj_name ^ ctx.ext_obj) :: extra_targets
| Cmx -> (Path.extend_basename m.obj_name ~suffix:ctx.ext_obj) :: extra_targets
| Cmi | Cmo -> extra_targets
in
let dep_graph = Ml_kind.Dict.get dep_graph ml_kind in
Expand All @@ -1092,14 +1093,14 @@ module Gen(P : Params) = struct
deps
~f:(fun m ->
match cm_kind with
| Cmi | Cmo -> [Module.cm_file m ~dir Cmi]
| Cmx -> [Module.cm_file m ~dir Cmi; Module.cm_file m ~dir Cmx])))
| Cmi | Cmo -> [Module.cm_file m Cmi]
| Cmx -> [Module.cm_file m Cmi; Module.cm_file m Cmx])))
in
let extra_targets, cmt_args =
match cm_kind with
| Cmx -> (extra_targets, Arg_spec.S [])
| Cmi | Cmo ->
let fn = Option.value_exn (Module.cmt_file m ~dir ml_kind) in
let fn = Option.value_exn (Module.cmt_file m ml_kind) in
(fn :: extra_targets, A "-bin-annot")
in
add_rule
Expand Down Expand Up @@ -1211,7 +1212,7 @@ module Gen(P : Params) = struct
]))

let mk_lib_cm_all (lib : Library.t) ~dir ~modules cm_kind =
let deps = cm_files ~dir (String_map.values modules) ~cm_kind in
let deps = cm_files (String_map.values modules) ~cm_kind in
add_rule (Build.paths deps >>>
Build.create_file (lib_cm_all lib ~dir cm_kind))

Expand Down Expand Up @@ -1289,7 +1290,9 @@ module Gen(P : Params) = struct
if not lib.wrapped || m.name = main_module_name then
{ m with obj_name = obj_name_of_basename m.ml_fname }
else
{ m with obj_name = sprintf "%s__%s" lib.name m.name })
{ m with obj_name =
Path.relative (Path.parent m.ml_fname)
(sprintf "%s__%s" lib.name m.name) })
in
let alias_module =
if not lib.wrapped ||
Expand All @@ -1306,9 +1309,9 @@ module Gen(P : Params) = struct
Some
{ Module.
name = main_module_name ^ suf
; ml_fname = lib.name ^ suf ^ ".ml-gen"
; ml_fname = Path.relative dir (lib.name ^ suf ^ ".ml-gen")
; mli_fname = None
; obj_name = lib.name ^ suf
; obj_name = Path.relative dir (lib.name ^ suf)
}
in
(* Add the modules before preprocessing, otherwise the install rules are going to pick
Expand Down Expand Up @@ -1346,7 +1349,7 @@ module Gen(P : Params) = struct
main_module_name m.name
m.name (Module.real_unit_name m))
|> String.concat ~sep:"\n")
>>> Build.update_file_dyn (Path.relative dir m.ml_fname)));
>>> Build.update_file_dyn m.ml_fname));

let requires, real_requires =
requires ~dir ~dep_kind ~item:lib.name
Expand Down Expand Up @@ -1378,10 +1381,10 @@ module Gen(P : Params) = struct

if Library.has_stubs lib then begin
let h_files =
String_set.elements files
Path.Set.elements files
|> List.filter_map ~f:(fun fn ->
if String.is_suffix fn ~suffix:".h" then
Some (Path.relative dir fn)
if String.is_suffix (Path.basename fn) ~suffix:".h" then
Some fn
else
None)
in
Expand Down Expand Up @@ -1602,11 +1605,11 @@ module Gen(P : Params) = struct
| Modules listing |
+-----------------------------------------------------------------+ *)

let guess_modules ~dir ~files =
let guess_modules ~files =
let ml_files, mli_files =
String_set.elements files
Path.Set.elements files
|> List.filter_map ~f:(fun fn ->
match String.lsplit2 fn ~on:'.' with
match String.lsplit2 (Path.basename fn) ~on:'.' with
| Some (_, "ml") ->
Some (Inl fn)
| Some (_, "mli") ->
Expand All @@ -1617,14 +1620,14 @@ module Gen(P : Params) = struct
in
let parse_one_set files =
List.map files ~f:(fun fn ->
(String.capitalize_ascii (Filename.chop_extension fn),
(String.capitalize_ascii (Filename.chop_extension (Path.basename fn)),
fn))
|> String_map.of_alist
|> function
| Ok x -> x
| Error (name, f1, f2) ->
die "too many files for module %s in %s: %s and %s"
name (Path.to_string dir) f1 f2
die "too many files for module %s: %s and %s"
name (Path.to_string f1) (Path.to_string f2)
in
let impls = parse_one_set ml_files in
let intfs = parse_one_set mli_files in
Expand All @@ -1633,7 +1636,10 @@ module Gen(P : Params) = struct
match ml_fname with
| None ->
let mli_fname = Option.value_exn mli_fname in
let ml_fname = String.sub mli_fname ~pos:0 ~len:(String.length mli_fname - 1) in
let mli_parent = Path.parent mli_fname in
let mli_basename = Path.basename mli_fname in
let ml_basename = String.sub mli_basename ~pos:0 ~len:(String.length mli_basename - 1) in
let ml_fname = Path.relative mli_parent ml_basename in
Format.eprintf
"@{<warning>Warning@}: Module %s in %s doesn't have a \
corresponding .ml file.\n\
Expand All @@ -1643,13 +1649,12 @@ module Gen(P : Params) = struct
\ https://github.com/janestreet/jbuilder/issues/9\n\
\n\
In the meantime I'm setting up a rule for copying %s to %s.\n"
name (Path.to_string dir)
mli_fname ml_fname;
let dir = Path.append ctx.build_dir dir in
name (Path.to_string mli_parent)
mli_basename ml_basename;
add_rule
(Build.copy
~src:(Path.relative dir mli_fname)
~dst:(Path.relative dir ml_fname));
~src:(Path.append ctx.build_dir mli_fname)
~dst:(Path.append ctx.build_dir ml_fname));
ml_fname
| Some ml_fname -> ml_fname
in
Expand All @@ -1658,7 +1663,7 @@ module Gen(P : Params) = struct
name
; ml_fname = ml_fname
; mli_fname = mli_fname
; obj_name = ""
; obj_name = Path.of_string ""; (* dumb value *)
})

(* +-----------------------------------------------------------------+
Expand All @@ -1668,14 +1673,23 @@ module Gen(P : Params) = struct
let rules { src_dir; ctx_dir; stanzas } =
(* Interpret user rules and other simple stanzas first in order to populate the known
target table, which is needed for guessing the list of modules. *)
let src_dirs = ref [src_dir] in
List.iter stanzas ~f:(fun stanza ->
let dir = ctx_dir in
match (stanza : Stanza.t) with
| Rule rule -> user_rule rule ~dir
| Alias alias -> alias_rules alias ~dir
| Includes includes ->
let sub_dirs = List.map ~f:(Path.relative src_dir) includes.sub_dirs in
src_dirs := sub_dirs@(!src_dirs)
| Library _ | Executables _ | Provides _ | Install _ -> ());
let src_dirs = !src_dirs in
let files = lazy (
let files = sources_and_targets_known_so_far ~src_path:src_dir in
let for_one acc src_path =
let files = sources_and_targets_known_so_far ~src_path in
String_set.fold ~f:(fun e acc -> Path.Set.add (Path.relative src_path e) acc) ~init:acc files
in
let files = List.fold_left ~init:Path.Set.empty ~f:for_one src_dirs in
(* Manually add files generated by the (select ...) dependencies since we haven't
interpreted libraries and executables yet. *)
List.fold_left stanzas ~init:files ~f:(fun acc stanza ->
Expand All @@ -1684,13 +1698,16 @@ module Gen(P : Params) = struct
List.fold_left buildable.libraries ~init:acc ~f:(fun acc dep ->
match (dep : Jbuild_types.Lib_dep.t) with
| Direct _ -> acc
| Select s -> String_set.add s.result_fn acc)
| Select s -> Path.Set.add (Path.relative src_dir s.result_fn) acc)
| _ -> acc)
) in
let all_modules = lazy (
guess_modules ~dir:src_dir
~files:(Lazy.force files))
in
let all_modules = lazy (guess_modules ~files:(Lazy.force files)) in
(* append ctx_dir to all the files, they will be copied if needed *)
let files = lazy (Path.Set.fold
~init:Path.Set.empty
~f:(fun e acc -> Path.Set.add (Path.append ctx_dir e) acc)
(Lazy.force files)) in
let all_modules = lazy (String_map.map ~f:(Module.append ~dir:ctx_dir) (Lazy.force all_modules)) in
List.filter_map stanzas ~f:(fun stanza ->
let dir = ctx_dir in
match (stanza : Stanza.t) with
Expand Down Expand Up @@ -1845,12 +1862,12 @@ module Gen(P : Params) = struct
List.concat
[ List.concat_map modules ~f:(fun m ->
List.concat
[ [ Module.cm_file m ~dir Cmi ]
; if_ native [ Module.cm_file m ~dir Cmx ]
; List.filter_map Ml_kind.all ~f:(Module.cmt_file m ~dir)
; [ match Module.file m ~dir Intf with
[ [ Module.cm_file m Cmi ]
; if_ native [ Module.cm_file m Cmx ]
; List.filter_map Ml_kind.all ~f:(Module.cmt_file m)
; [ match Module.file m Intf with
| Some fn -> fn
| None -> Path.relative dir m.ml_fname ]
| None -> m.ml_fname ]
])
; if_ byte [ lib_archive ~dir lib ~ext:".cma" ]
; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ]
Expand Down
20 changes: 20 additions & 0 deletions src/jbuild_types.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -691,6 +691,23 @@ module Alias_conf = struct
common)
end

module Includes = struct
type t =
{ sub_dirs : string list; }

let common =
field "sub_dirs" (list string) >>= fun sub_dirs ->
return
{ sub_dirs }

let v1 = record common

let vjs =
record
(ignore_fields [] >>= fun () ->
common)
end

module Stanza = struct
type t =
| Library of Library.t
Expand All @@ -699,6 +716,7 @@ module Stanza = struct
| Provides of Provides.t
| Install of Install_conf.t
| Alias of Alias_conf.t
| Includes of Includes.t

let rules l = List.map l ~f:(fun x -> Rule x)

Expand All @@ -711,6 +729,7 @@ module Stanza = struct
; cstr "ocamlyacc" (list string @> nil) (fun x -> rules (Rule.ocamlyacc_v1 x))
; cstr "install" (Install_conf.v1 @> nil) (fun x -> [Install x])
; cstr "alias" (Alias_conf.v1 @> nil) (fun x -> [Alias x])
; cstr "includes" (Includes.v1 @> nil) (fun x -> [Includes x])
(* Just for validation and error messages *)
; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
]
Expand All @@ -726,6 +745,7 @@ module Stanza = struct
; cstr "provides" (Provides.vjs @> nil) (fun x -> [Provides x])
; cstr "install" (Install_conf.vjs @> nil) (fun x -> [Install x])
; cstr "alias" (Alias_conf.vjs @> nil) (fun x -> [Alias x])
; cstr "includes" (Includes.vjs @> nil) (fun x -> [Includes x])
; ign "enforce_style"
; ign "toplevel_expect_tests"
; ign "unified_tests"
Expand Down
Loading

0 comments on commit 2d1659d

Please sign in to comment.