matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge pull request #268 from janestreet/new-alias-semantic 

Sort out recursive/non-recursive aliases
This commit is contained in:
Rudi Grinberg 2017-10-19 15:33:23 +08:00 committed by GitHub
parent 604e599e4e e23f6fe8bb
commit a63276f5b3
29 changed files with 416 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
CHANGES.md
View File

@ -1,3 +1,16 @@
next
----
- Change the semantic of aliases: there are no longer aliases that are
recursive such as `install` or `runtest`. All aliases are
non-recursive. However, when requesting an alias from the command
line, this request the construction of the alias in the specified
directory and all its children recursively. This allows users to get
the same behavior as previous recursive aliases for their own
aliases, such as `example`. Inside jbuild files, one can use `(deps
(... (alias_rec xxx) ...))` to get the same behavior as on the
command line.
1.0+beta14 (11/10/2017)
-----------------------

54
bin/main.ml
View File

@ -70,8 +70,23 @@ module Main = struct
?filter_out_optional_stanzas_with_missing_deps ()
end
type target =
| File of Path.t
| Alias_rec of Alias.t
let request_of_targets (setup : Main.setup) targets =
let open Build.O in
List.fold_left targets ~init:(Build.return ()) ~f:(fun acc target ->
acc >>>
match target with
| File path -> Build.path path
| Alias_rec alias ->
Alias.dep_rec ~loc:(Loc.in_file "<command-line>")
~file_tree:setup.file_tree alias)
let do_build (setup : Main.setup) targets =
Build_system.do_build_exn setup.build_system targets
Build_system.do_build_exn setup.build_system
~request:(request_of_targets setup targets)
let find_root () =
let cwd = Sys.getcwd () in
@ -338,10 +353,6 @@ let resolve_package_install setup pkg =
| Error () ->
die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages))
type target =
| File of Path.t
| Alias of Path.t * Alias.t
let target_hint (setup : Main.setup) path =
assert (Path.is_local path);
let sub_dir = Path.parent path in
@ -379,9 +390,7 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
if Path.is_root path then
die "@@ on the command line must be followed by a valid alias name"
else
let dir = Path.parent path in
let name = Path.basename path in
[Alias (path, Alias.make ~dir name)]
[Alias_rec (Alias.of_path path)]
else
let path = Path.relative Path.root (prefix_target common s) in
let can't_build path =
@ -420,13 +429,13 @@ let resolve_targets ~log common (setup : Main.setup) user_targets =
List.iter targets ~f:(function
| File path ->
Log.info log @@ "- " ^ (Path.to_string path)
| Alias (path, _) ->
Log.info log @@ "- alias " ^ (Path.to_string path));
| Alias_rec alias ->
let path = Alias.fully_qualified_name alias in
Log.info log @@ "- recursive alias " ^
(Path.to_string_maybe_quoted path));
flush stdout;
end;
List.map targets ~f:(function
| File path -> path
| Alias (_, alias) -> Alias.file alias)
targets
let build_targets =
let doc = "Build the given targets, or all installable targets if none are given." in
@ -471,7 +480,7 @@ let runtest =
let targets =
List.map dirs ~f:(fun dir ->
let dir = Path.(relative root) (prefix_target common dir) in
Alias.file (Alias.runtest ~dir))
Alias_rec (Alias.runtest ~dir))
in
do_build setup targets) in
( Term.(const go
@ -522,9 +531,10 @@ let external_lib_deps =
(Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
>>= fun setup ->
let targets = resolve_targets ~log common setup targets in
let request = request_of_targets setup targets in
let failure =
String_map.fold ~init:false
(Build_system.all_lib_deps_by_context setup.build_system targets)
(Build_system.all_lib_deps_by_context setup.build_system ~request)
~f:(fun ~key:context_name ~data:lib_deps acc ->
let internals =
Jbuild.Stanzas.lib_names
@ -623,12 +633,12 @@ let rules =
Future.Scheduler.go ~log
(Main.setup ~log common ~filter_out_optional_stanzas_with_missing_deps:false
>>= fun setup ->
let targets =
let request =
match targets with
| [] -> Build_system.all_targets setup.build_system
| _ -> resolve_targets ~log common setup targets
| [] -> Build.paths (Build_system.all_targets setup.build_system)
| _ -> resolve_targets ~log common setup targets |> request_of_targets setup
in
Build_system.build_rules setup.build_system targets ~recursive >>= fun rules ->
Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
let print oc =
let ppf = Format.formatter_of_out_channel oc in
Sexp.prepare_formatter ppf;
@ -918,10 +928,10 @@ let utop =
let target =
match resolve_targets ~log common setup [utop_target] with
| [] -> die "no libraries defined in %s" dir
| [target] -> target
| _::_::_ -> assert false
| [File target] -> target
| [Alias_rec _] | _::_::_ -> assert false
in
do_build setup [target] >>| fun () ->
do_build setup [File target] >>| fun () ->
(setup.build_system, context, Path.to_string target)
) |> Future.Scheduler.go ~log in
Build_system.dump_trace build_system;

4
doc/jbuild.rst
View File

@ -843,6 +843,10 @@ syntax:
- ``(file <filename>)`` or simply ``<filename>``: depend on this file
- ``(alias <alias-name>)``: depend on the construction of this alias, for
instance: ``(alias src/runtest)``
- ``(alias_rec <alias-name>)``: depend on the construction of this
alias recursively in all children directories wherever it is
defined. For instance: ``(alias_rec src/runtest)`` might depend on
``(alias src/runtest)``, ``(alias src/foo/bar/runtest)``, ...
- ``(glob_files <glob>)``: depend on all files matched by ``<glob>``, see the
:ref:`glob <glob>` for details
- ``(files_recursively_in <dir>)``: depend on all files in the subtree with root

11
doc/terminology.rst
View File

@ -43,11 +43,12 @@ Terminology
- **build context root**: the root of a build context named ``foo`` is
``<root>/_build/<foo>``
- **alias**: an alias is a build target that doesn't produce any file
and has configurable dependencies. Alias are per-directory and some
are recursive; asking an alias to be built in a given directory will
trigger the construction of the alias in all children directories
recursively. The most interesting ones are:
- **alias**: an alias is a build target that doesn't produce any file
and has configurable dependencies. Aliases are
per-directory. However, on the command line, asking for an alias to
be built in a given directory will trigger the construction of the
alias in all children directories recursively. Jbuilder defines the
following standard aliases:
- ``runtest`` which runs user defined tests
- ``install`` which depends on everything that should be installed

5
doc/usage.rst
View File

@ -125,8 +125,9 @@ Aliases
-------
Targets starting with a ``@`` are interpreted as aliases. For instance
``@src/runtest`` means the alias ``src/runtest``. If you want to refer
to a target starting with a ``@``, simply write: ``./@foo``.
``@src/runtest`` means the alias ``runtest`` in all descendant of
``src`` where it is defined. If you want to refer to a target starting
with a ``@``, simply write: ``./@foo``.
Note that an alias not pointing to the ``_build`` directory always
depends on all the corresponding aliases in build contexts.

77
src/alias.ml
View File

@ -3,12 +3,14 @@ open! Import
(** Fully qualified name *)
module Fq_name : sig
type t
val pp : Format.formatter -> t -> unit
val make : Path.t -> t
val path : t -> Path.t
end = struct
type t = Path.t
let make t = t
let path t = t
let pp = Path.pp
end
type t =
@ -16,6 +18,10 @@ type t =
; file : Path.t
}
let pp fmt t =
Format.fprintf fmt "@[<2>{ name@ =@ %a@ ;@ file@ =@ %a }@]"
Path.pp (Fq_name.path t.name) Path.pp t.file
let aliases_path = Path.(relative root) "_build/.aliases"
let suffix = "-" ^ String.make 32 '0'
@ -32,12 +38,43 @@ let of_path path =
let name t = Path.basename (Fq_name.path t.name)
let dir t = Path.parent (Fq_name.path t.name)
let fully_qualified_name t = Fq_name.path t.name
let make name ~dir =
assert (not (String.contains name '/'));
of_path (Path.relative dir name)
let dep t = Build.path t.file
let is_standard = function
| "runtest" | "install" | "doc" -> true
| _ -> false
let dep_rec ~loc ~file_tree t =
let path = Path.parent (Fq_name.path t.name) |> Path.drop_build_context in
let name = Path.basename (Fq_name.path t.name) in
match File_tree.find_dir file_tree path with
| None -> Build.fail { fail = fun () ->
Loc.fail loc "Don't know about directory %s!" (Path.to_string_maybe_quoted path) }
| Some dir ->
let open Build.O in
File_tree.Dir.fold dir ~traverse_ignored_dirs:false ~init:(Build.return true)
~f:(fun dir acc ->
let path = File_tree.Dir.path dir in
let t = of_path (Path.relative path name) in
acc
>>>
Build.if_file_exists t.file
~then_:(Build.path t.file
>>^
fun _ -> false)
~else_:(Build.arr (fun x -> x)))
>>^ fun is_empty ->
if is_empty && not (is_standard name) then
Loc.fail loc "This alias is empty.\n\
Alias %S is not defined in %s or any of its descendants."
name (Path.to_string_maybe_quoted path)
let file t = t.file
let file_with_digest_suffix t ~digest =
@ -77,20 +114,29 @@ let runtest = make "runtest"
let install = make "install"
let doc = make "doc"
let recursive_aliases =
[ default
; runtest
; install
; doc
]
module Store = struct
type entry =
{ alias : t
; mutable deps : Path.Set.t
}
let pp_entry fmt entry =
let pp_deps fmt deps =
Format.pp_print_list Path.pp fmt (Path.Set.elements deps) in
Format.fprintf fmt "@[<2>{@ alias@ =@ %a@ ;@ deps@ = (%a)@ }@]"
pp entry.alias pp_deps entry.deps
type t = (Fq_name.t, entry) Hashtbl.t
let pp fmt (t : t) =
let bindings = Hashtbl.fold ~init:[] ~f:(fun ~key ~data acc ->
(key, data)::acc
) t in
let pp_bindings fmt b =
Format.pp_print_list (fun fmt (k, v) ->
Format.fprintf fmt "@[<2>(%a@ %a)@]" Fq_name.pp k pp_entry v
) fmt b in
Format.fprintf fmt "Store.t@ @[@<2>(%a)@]" pp_bindings bindings
let create () = Hashtbl.create 1024
end
@ -104,22 +150,7 @@ let add_deps store t deps =
}
| Some e -> e.deps <- Path.Set.union deps e.deps
type tree = Node of Path.t * tree list
let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) =
let alias = make_alias ~dir:(Path.append prefix dir) in
add_deps store alias (List.map children ~f:(fun child ->
setup_rec_alias store ~make_alias ~prefix ~tree:child));
alias.file
let setup_rec_aliases store ~prefix ~tree =
List.iter recursive_aliases ~f:(fun make_alias ->
ignore (setup_rec_alias store ~make_alias ~prefix ~tree : Path.t))
let rules store ~prefixes ~tree =
List.iter prefixes ~f:(fun prefix ->
setup_rec_aliases store ~prefix ~tree);
let rules store =
(* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *)
Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc ->
match Path.extract_build_context (Fq_name.path alias.name) with

23
src/alias.mli
View File

@ -1,7 +1,13 @@
open Import
type t
val pp : t Fmt.t
val make : string -> dir:Path.t -> t
val of_path : Path.t -> t
(** The following always holds:
{[
@ -11,6 +17,8 @@ val make : string -> dir:Path.t -> t
val name : t -> string
val dir : t -> Path.t
val fully_qualified_name : t -> Path.t
val default : dir:Path.t -> t
val runtest : dir:Path.t -> t
val install : dir:Path.t -> t
@ -18,6 +26,10 @@ val doc : dir:Path.t -> t
val dep : t -> ('a, 'a) Build.t
(** Implements [(alias_rec ...)] in dependency specification and
[@alias] on the command line. *)
val dep_rec : loc:Loc.t -> file_tree:File_tree.t -> t -> (unit, unit) Build.t
(** File that represent the alias in the filesystem. It is a file under
[_build/.aliases]. *)
val file : t -> Path.t
@ -43,15 +55,12 @@ val name_of_file : Path.t -> string option
module Store : sig
type t
val pp : t Fmt.t
val create : unit -> t
end
val add_deps : Store.t -> t -> Path.t list -> unit
type tree = Node of Path.t * tree list
val rules
: Store.t
-> prefixes:Path.t list
-> tree:tree
-> Build_interpret.Rule.t list
val rules : Store.t -> Build_interpret.Rule.t list

78
src/build_system.ml
View File

@ -125,6 +125,7 @@ type t =
[(deps (filename + contents), targets (filename only), action)] *)
trace : (Path.t, Digest.t) Hashtbl.t
; mutable local_mkdirs : Path.Local.Set.t
; all_targets_by_dir : Pset.t Pmap.t Lazy.t
}
let all_targets t = Hashtbl.fold t.files ~init:[] ~f:(fun ~key ~data:_ acc -> key :: acc)
@ -304,6 +305,9 @@ module Build_exec = struct
let dyn_deps = ref Pset.empty in
let action = exec dyn_deps (Build.repr t) x in
(action, !dyn_deps)
let exec_nop bs t x =
snd (exec bs (Build.O.(>>^) t (fun () -> Action.Progn [])) x)
end
(* This variable is filled during the creation of the build system. Once the build system
@ -603,14 +607,14 @@ let dump_trace t = Trace.dump t.trace
let create ~contexts ~file_tree ~rules =
let all_source_files =
File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc ->
let path = File_tree.Dir.path dir in
Cont
(Pset.union acc
(File_tree.Dir.files dir
|> String_set.elements
|> List.map ~f:(Path.relative path)
|> Pset.of_list)))
File_tree.fold file_tree ~init:Pset.empty ~traverse_ignored_dirs:true
~f:(fun dir acc ->
let path = File_tree.Dir.path dir in
Pset.union acc
(File_tree.Dir.files dir
|> String_set.elements
|> List.map ~f:(Path.relative path)
|> Pset.of_list))
in
let all_copy_targets =
List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->
@ -638,6 +642,7 @@ let create ~contexts ~file_tree ~rules =
; files = Hashtbl.create 1024
; trace = Trace.load ()
; local_mkdirs = Path.Local.Set.empty
; all_targets_by_dir
} in
List.iter rules ~f:(compile_rule t ~all_targets_by_dir ~copy_source:false);
setup_copy_rules t ~all_targets_by_dir
@ -717,13 +722,34 @@ let remove_old_artifacts t =
walk (Config.local_install_dir ~context:ctx.name);
)
let do_build_exn t targets =
remove_old_artifacts t;
all_unit (List.map targets ~f:(fun fn -> wait_for_file t fn ~targeting:fn))
let eval_request t ~request ~process_target =
let { Build_interpret.Static_deps.
rule_deps
; action_deps = static_deps
} = Build_interpret.static_deps request ~all_targets_by_dir:t.all_targets_by_dir
in
let do_build t targets =
let process_targets ts =
Future.all_unit (List.map (Pset.elements ts) ~f:process_target)
in
Future.both
(process_targets static_deps)
(Future.all_unit (List.map (Pset.elements rule_deps) ~f:(fun fn ->
wait_for_file t fn ~targeting:fn))
>>= fun () ->
let dyn_deps = Build_exec.exec_nop t request () in
process_targets (Pset.diff dyn_deps static_deps))
>>| fun ((), ()) -> ()
let do_build_exn t ~request =
remove_old_artifacts t;
eval_request t ~request ~process_target:(fun fn ->
wait_for_file t fn ~targeting:fn)
let do_build t ~request =
try
Ok (do_build_exn t targets)
Ok (do_build_exn t ~request)
with Build_error.E e ->
Error e
@ -760,7 +786,16 @@ let rules_for_targets t targets =
Path.to_string (Pset.choose rule.Internal_rule.targets))
|> String.concat ~sep:"\n-> ")
let all_lib_deps t targets =
let static_deps_of_request t request =
let { Build_interpret.Static_deps.
rule_deps
; action_deps
} = Build_interpret.static_deps request ~all_targets_by_dir:t.all_targets_by_dir
in
Pset.elements (Pset.union rule_deps action_deps)
let all_lib_deps t ~request =
let targets = static_deps_of_request t request in
List.fold_left (rules_for_targets t targets) ~init:Pmap.empty
~f:(fun acc rule ->
let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
@ -771,7 +806,8 @@ let all_lib_deps t targets =
| None, Some b -> Some b
| Some a, Some b -> Some (Build.merge_lib_deps a b)))
let all_lib_deps_by_context t targets =
let all_lib_deps_by_context t ~request =
let targets = static_deps_of_request t request in
List.fold_left (rules_for_targets t targets) ~init:[] ~f:(fun acc rule ->
let lib_deps = Build_interpret.lib_deps rule.Internal_rule.build in
Path.Map.fold lib_deps ~init:acc ~f:(fun ~key:path ~data:lib_deps acc ->
@ -817,7 +853,7 @@ module Rule_closure =
rules_for_files graph (Pset.elements t.deps)
end)
let build_rules t ?(recursive=false) targets =
let build_rules ?(recursive=false) t ~request =
let rules_seen = ref Id_set.empty in
let rules = ref [] in
let rec loop fn =
@ -863,7 +899,10 @@ let build_rules t ?(recursive=false) targets =
return ()
end
in
Future.all_unit (List.map targets ~f:loop)
let targets = ref Pset.empty in
eval_request t ~request ~process_target:(fun fn ->
targets := Pset.add fn !targets;
loop fn)
>>= fun () ->
Future.all !rules
>>| fun rules ->
@ -872,7 +911,10 @@ let build_rules t ?(recursive=false) targets =
Pset.fold r.targets ~init:acc ~f:(fun fn acc ->
Pmap.add acc ~key:fn ~data:r))
in
match Rule_closure.top_closure rules (rules_for_files rules targets) with
match
Rule_closure.top_closure rules
(rules_for_files rules (Pset.elements !targets))
with
| Ok l -> l
| Error cycle ->
die "dependency cycle detected:\n %s"

34
src/build_system.mli
View File

@ -23,16 +23,28 @@ module Build_error : sig
end
(** Do the actual build *)
val do_build : t -> Path.t list -> (unit Future.t, Build_error.t) result
val do_build_exn : t -> Path.t list -> unit Future.t
val do_build
: t
-> request:(unit, unit) Build.t
-> (unit Future.t, Build_error.t) result
val do_build_exn
: t
-> request:(unit, unit) Build.t
-> unit Future.t
(** Return all the library dependencies (as written by the user) needed to build these
targets *)
val all_lib_deps : t -> Path.t list -> Build.lib_deps Path.Map.t
(** Return all the library dependencies (as written by the user)
needed to build this request *)
val all_lib_deps
: t
-> request:(unit, unit) Build.t
-> Build.lib_deps Path.Map.t
(** Return all the library dependencies required to build these targets, by context
name *)
val all_lib_deps_by_context : t -> Path.t list -> Build.lib_deps String_map.t
(** Return all the library dependencies required to build this
request, by context name *)
val all_lib_deps_by_context
: t
-> request:(unit, unit) Build.t
-> Build.lib_deps String_map.t
(** List of all buildable targets *)
val all_targets : t -> Path.t list
@ -58,9 +70,9 @@ end
[recursive] is [true], return all the rules needed to build the
given targets and their transitive dependencies. *)
val build_rules
: t
-> ?recursive:bool (* default false *)
-> Path.t list
: ?recursive:bool (* default false *)
-> t
-> request:(unit, unit) Build.t
-> Rule.t list Future.t
val all_targets_ever_built

85
src/file_tree.ml
View File

@ -1,31 +1,25 @@
open! Import
type 'a fold_callback_result =
| Cont of 'a
| Dont_recurse_in of String_set.t * 'a
module Dir = struct
type t =
{ path : Path.t
; files : String_set.t
; sub_dirs : t String_map.t
; ignored : bool
}
let path t = t.path
let files t = t.files
let sub_dirs t = t.sub_dirs
let ignored t = t.ignored
let rec fold t ~init ~f =
match f t init with
| Cont init ->
String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc ->
fold t ~init:acc ~f)
| Dont_recurse_in (forbidden, init) ->
String_map.fold t.sub_dirs ~init ~f:(fun ~key:sub_dir ~data:t acc ->
if String_set.mem sub_dir forbidden then
acc
else
fold t ~init:acc ~f)
let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
if not traverse_ignored_dirs && t.ignored then
acc
else
let acc = f t acc in
String_map.fold t.sub_dirs ~init:acc ~f:(fun ~key:_ ~data:t acc ->
fold t ~traverse_ignored_dirs ~init:acc ~f)
end
type t =
@ -40,38 +34,59 @@ let ignore_file fn ~is_directory =
(is_directory && (fn.[0] = '.' || fn.[0] = '_')) ||
(fn.[0] = '.' && fn.[1] = '#')
let load path =
let rec walk path : Dir.t =
let load ?(extra_ignored_subtrees=Path.Set.empty) path =
let rec walk path ~ignored : Dir.t =
let files, sub_dirs =
Path.readdir path
|> List.filter_map ~f:(fun fn ->
let path = Path.relative path fn in
let is_directory = Path.exists path && Path.is_directory path in
let is_directory =
try Path.is_directory path with _ -> false
in
if ignore_file fn ~is_directory then
None
else if is_directory then
Some (Inr (fn, path))
else
Some (fn, path, is_directory))
|> List.partition_map ~f:(fun (fn, path, is_directory) ->
if is_directory then
Inr (fn, walk path)
else
Inl fn)
Some (Inl fn))
|> List.partition_map ~f:(fun x -> x)
in
let files = String_set.of_list files in
let ignored_sub_dirs =
if not ignored && String_set.mem "jbuild-ignore" files then
String_set.of_list
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
else
String_set.empty
in
let sub_dirs =
List.map sub_dirs ~f:(fun (fn, path) ->
let ignored =
ignored
|| String_set.mem fn ignored_sub_dirs
|| Path.Set.mem path extra_ignored_subtrees
in
(fn, walk path ~ignored))
|> String_map.of_alist_exn
in
{ path
; files = String_set.of_list files
; sub_dirs = String_map.of_alist_exn sub_dirs
; files
; sub_dirs
; ignored
}
in
let root = walk path in
let root = walk path ~ignored:false in
let dirs =
Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
Cont (Path.Map.add acc ~key:dir.path ~data:dir))
Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
~f:(fun dir acc ->
Path.Map.add acc ~key:dir.path ~data:dir)
in
{ root
; dirs
}
let fold t ~init ~f = Dir.fold t.root ~init ~f
let fold t ~traverse_ignored_dirs ~init ~f =
Dir.fold t.root ~traverse_ignored_dirs ~init ~f
let find_dir t path =
Path.Map.find path t.dirs
@ -89,8 +104,8 @@ let files_recursively_in t ?(prefix_with=Path.root) path =
match find_dir t path with
| None -> Path.Set.empty
| Some dir ->
Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc ->
let path = Path.append prefix_with (Dir.path dir) in
Cont
(String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
Path.Set.add (Path.relative path fn) acc)))
Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
~f:(fun dir acc ->
let path = Path.append prefix_with (Dir.path dir) in
String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
Path.Set.add (Path.relative path fn) acc))

25
src/file_tree.mli
View File

@ -1,23 +1,34 @@
open! Import
module Dir : sig
type t
val path : t -> Path.t
val files : t -> String_set.t
val sub_dirs : t -> t String_map.t
(** Whether this directory is ignored by a [jbuild-ignore] file in
one of its ancestor directories. *)
val ignored : t -> bool
val fold
: t
-> traverse_ignored_dirs:bool
-> init:'a
-> f:(t -> 'a -> 'a)
-> 'a
end
type t
val load : Path.t -> t
val load : ?extra_ignored_subtrees:Path.Set.t -> Path.t -> t
type 'a fold_callback_result =
| Cont of 'a
| Dont_recurse_in of String_set.t * 'a
val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a fold_callback_result) -> 'a
val fold
: t
-> traverse_ignored_dirs:bool
-> init:'a
-> f:(Dir.t -> 'a -> 'a)
-> 'a
val root : t -> Dir.t

6
src/gen_rules.ml
View File

@ -1104,7 +1104,7 @@ end
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
?only_packages conf =
let open Future in
let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
let { Jbuild_load. file_tree; jbuilds; packages } = conf in
let aliases = Alias.Store.create () in
let dirs_with_dot_opam_files =
String_map.fold packages ~init:Path.Set.empty
@ -1150,7 +1150,5 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|> Future.all
>>| fun l ->
let rules, context_names_and_stanzas = List.split l in
(Alias.rules aliases
~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
@ List.concat rules,
(Alias.rules aliases @ List.concat rules,
String_map.of_alist_exn context_names_and_stanzas)

4
src/import.ml
View File

@ -504,3 +504,7 @@ let open_out_gen = `Use_Io
module No_io = struct
module Io = struct end
end
module Fmt = struct
type 'a t = Format.formatter -> 'a -> unit
end

4
src/jbuild.ml
View File

@ -200,6 +200,7 @@ module Dep_conf = struct
type t =
| File of String_with_vars.t
| Alias of String_with_vars.t
| Alias_rec of String_with_vars.t
| Glob_files of String_with_vars.t
| Files_recursively_in of String_with_vars.t
@ -211,6 +212,7 @@ module Dep_conf = struct
sum
[ cstr "file" (fun x -> File x)
; cstr "alias" (fun x -> Alias x)
; cstr "alias_rec" (fun x -> Alias_rec x)
; cstr "glob_files" (fun x -> Glob_files x)
; cstr "files_recursively_in" (fun x -> Files_recursively_in x)
]
@ -226,6 +228,8 @@ module Dep_conf = struct
List [Atom "file" ; String_with_vars.sexp_of_t t]
| Alias t ->
List [Atom "alias" ; String_with_vars.sexp_of_t t]
| Alias_rec t ->
List [Atom "alias_rec" ; String_with_vars.sexp_of_t t]
| Glob_files t ->
List [Atom "glob_files" ; String_with_vars.sexp_of_t t]
| Files_recursively_in t ->

1
src/jbuild.mli
View File

@ -93,6 +93,7 @@ module Dep_conf : sig
type t =
| File of String_with_vars.t
| Alias of String_with_vars.t
| Alias_rec of String_with_vars.t
| Glob_files of String_with_vars.t
| Files_recursively_in of String_with_vars.t

96
src/jbuild_load.ml
View File

@ -151,7 +151,6 @@ end
type conf =
{ file_tree : File_tree.t
; tree : Alias.tree
; jbuilds : Jbuilds.t
; packages : Package.t String_map.t
}
@ -164,41 +163,27 @@ let load ~dir ~scope =
| Ocaml_script ->
Script { dir; scope }
let load ?(extra_ignored_subtrees=Path.Set.empty) () =
let ftree = File_tree.load Path.root in
let packages, ignored_subtrees =
File_tree.fold ftree ~init:([], extra_ignored_subtrees) ~f:(fun dir (pkgs, ignored) ->
let load ?extra_ignored_subtrees () =
let ftree = File_tree.load Path.root ?extra_ignored_subtrees in
let packages =
File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
let pkgs =
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
match Filename.split_extension fn with
| (pkg, ".opam") when pkg <> "" ->
let version_from_opam_file =
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
match Opam_file.get_field opam "version" with
| Some (String (_, s)) -> Some s
| _ -> None
in
(pkg,
{ Package. name = pkg
; path
; version_from_opam_file
}) :: acc
| _ -> acc)
in
if String_set.mem "jbuild-ignore" files then
let ignore_set =
String_set.of_list
(Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
in
Dont_recurse_in
(ignore_set,
(pkgs,
String_set.fold ignore_set ~init:ignored ~f:(fun fn acc ->
Path.Set.add (Path.relative path fn) acc)))
else
Cont (pkgs, ignored))
String_set.fold files ~init:pkgs ~f:(fun fn acc ->
match Filename.split_extension fn with
| (pkg, ".opam") when pkg <> "" ->
let version_from_opam_file =
let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
match Opam_file.get_field opam "version" with
| Some (String (_, s)) -> Some s
| _ -> None
in
(pkg,
{ Package. name = pkg
; path
; version_from_opam_file
}) :: acc
| _ -> acc))
in
let packages =
String_map.of_alist_multi packages
@ -219,32 +204,27 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
|> Path.Map.map ~f:Scope.make
in
let rec walk dir jbuilds scope =
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
let sub_dirs = File_tree.Dir.sub_dirs dir in
let scope = Path.Map.find_default path scopes ~default:scope in
let jbuilds =
if String_set.mem "jbuild" files then
let jbuild = load ~dir:path ~scope in
jbuild :: jbuilds
else
jbuilds
in
let children, jbuilds =
String_map.fold sub_dirs ~init:([], jbuilds)
~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
(children, jbuilds)
else
let child, jbuilds = walk dir jbuilds scope in
(child :: children, jbuilds))
in
(Alias.Node (path, children), jbuilds)
if File_tree.Dir.ignored dir then
jbuilds
else begin
let path = File_tree.Dir.path dir in
let files = File_tree.Dir.files dir in
let sub_dirs = File_tree.Dir.sub_dirs dir in
let scope = Path.Map.find_default path scopes ~default:scope in
let jbuilds =
if String_set.mem "jbuild" files then
let jbuild = load ~dir:path ~scope in
jbuild :: jbuilds
else
jbuilds
in
String_map.fold sub_dirs ~init:jbuilds
~f:(fun ~key:_ ~data:dir jbuilds ->
walk dir jbuilds scope)
end
in
let root = File_tree.root ftree in
let tree, jbuilds = walk root [] Scope.empty in
let jbuilds = walk (File_tree.root ftree) [] Scope.empty in
{ file_tree = ftree
; tree
; jbuilds
; packages
}

1
src/jbuild_load.mli
View File

@ -9,7 +9,6 @@ end
type conf =
{ file_tree : File_tree.t
; tree : Alias.tree
; jbuilds : Jbuilds.t
; packages : Package.t String_map.t
}

8
src/main.ml
View File

@ -6,6 +6,7 @@ type setup =
; stanzas : (Path.t * Jbuild.Scope.t * Jbuild.Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
; file_tree : File_tree.t
}
let package_install_file { packages; _ } pkg =
@ -54,6 +55,7 @@ let setup ?(log=Log.no_log) ?filter_out_optional_stanzas_with_missing_deps
; stanzas
; contexts
; packages = conf.packages
; file_tree = conf.file_tree
}
let external_lib_deps ?log ~packages () =
@ -71,7 +73,8 @@ let external_lib_deps ?log ~packages () =
| Some stanzas ->
let internals = Jbuild.Stanzas.lib_names stanzas in
Path.Map.map
(Build_system.all_lib_deps setup.build_system install_files)
(Build_system.all_lib_deps setup.build_system
~request:(Build.paths install_files))
~f:(String_map.filter ~f:(fun name _ ->
not (String_set.mem name internals))))
@ -211,7 +214,8 @@ let bootstrap () =
~extra_ignored_subtrees:ignored_during_bootstrap
()
>>= fun { build_system = bs; _ } ->
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
Build_system.do_build_exn bs
~request:(Build.path (Path.(relative root) (pkg ^ ".install"))))
in
try
main ()

1
src/main.mli
View File

@ -7,6 +7,7 @@ type setup =
stanzas : (Path.t * Scope.t * Stanzas.t) list String_map.t
; contexts : Context.t list
; packages : Package.t String_map.t
; file_tree : File_tree.t
}
(* Returns [Error ()] if [pkg] is unknown *)

2
src/path.ml
View File

@ -424,3 +424,5 @@ let rm_rf =
let change_extension ~ext t =
let t = try Filename.chop_extension t with Not_found -> t in
t ^ ext
let pp = Format.pp_print_string

2
src/path.mli
View File

@ -111,3 +111,5 @@ val rm_rf : t -> unit
(** Changes the extension of the filename (or adds an extension if there was none) *)
val change_extension : ext:string -> t -> t
val pp : t Fmt.t

14
src/super_context.ml
View File

@ -406,15 +406,21 @@ module Deps = struct
open Build.O
open Dep_conf
let make_alias t ~scope ~dir s =
Alias.of_path (Path.relative dir (expand_vars t ~scope ~dir s))
let dep t ~scope ~dir = function
| File s ->
let path = Path.relative dir (expand_vars t ~scope ~dir s) in
Build.path path
>>^ fun _ -> [path]
>>^ fun () -> [path]
| Alias s ->
let path = Alias.file (Alias.make ~dir (expand_vars t ~scope ~dir s)) in
Build.path path
>>^ fun _ -> []
Alias.dep (make_alias t ~scope ~dir s)
>>^ fun () -> []
| Alias_rec s ->
Alias.dep_rec ~loc:(String_with_vars.loc s) ~file_tree:t.file_tree
(make_alias t ~scope ~dir s)
>>^ fun () -> []
| Glob_files s -> begin
let path = Path.relative dir (expand_vars t ~scope ~dir s) in
match Glob_lexer.parse_string (Path.basename path) with

7
test/blackbox-tests/jbuild
View File

@ -71,3 +71,10 @@
(action
(chdir test-cases/copy_files
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
(alias
((name runtest)
(deps ((files_recursively_in test-cases/aliases)))
(action
(chdir test-cases/aliases
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))

9
test/blackbox-tests/test-cases/aliases/jbuild Normal file
View File

@ -0,0 +1,9 @@
(jbuild_version 1)
(alias
((name just-in-src)
(deps ((alias src/x)))))
(alias
((name everywhere)
(deps ((alias_rec x)))))

22
test/blackbox-tests/test-cases/aliases/run.t Normal file
View File

@ -0,0 +1,22 @@
$ $JBUILDER clean -j1 --root .
$ $JBUILDER build -j1 --root . @just-in-src
running in src
$ $JBUILDER clean -j1 --root .
$ $JBUILDER build -j1 --root . @everywhere
running in src/foo/bar
running in src/foo/baz
running in src
$ $JBUILDER clean -j1 --root .
$ $JBUILDER build -j1 --root . @x
running in src/foo/bar
running in src/foo/baz
running in src
$ $JBUILDER build -j1 --root . @plop
File "<command-line>", line 1, characters 0-0:
Error: This alias is empty.
Alias "plop" is not defined in . or any of its descendants.
[1]
$ $JBUILDER build -j1 --root . @truc/x
File "<command-line>", line 1, characters 0-0:
Error: Don't know about directory truc!
[1]

5
test/blackbox-tests/test-cases/aliases/src/foo/bar/jbuild Normal file
View File

@ -0,0 +1,5 @@
(jbuild_version 1)
(alias
((name x)
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

5
test/blackbox-tests/test-cases/aliases/src/foo/baz/jbuild Normal file
View File

@ -0,0 +1,5 @@
(jbuild_version 1)
(alias
((name x)
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

5
test/blackbox-tests/test-cases/aliases/src/jbuild Normal file
View File

@ -0,0 +1,5 @@
(jbuild_version 1)
(alias
((name x)
(action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n")))))

28
test/blackbox-tests/test-cases/js_of_ocaml/run.t
View File

@ -1,29 +1,29 @@
$ $JBUILDER build -j1 --root . --dev bin/technologic.bc.js @install lib/x.cma.js lib/x__Y.cmo.js bin/z.cmo.js
ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe
ocamlc lib/stubs.o
ocamlopt .ppx/js_of_ocaml-ppx/ppx.exe
ocamlc lib/x__.{cmi,cmo,cmt}
ppx bin/technologic.pp.ml
ppx bin/z.pp.ml
ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a
ppx lib/x.pp.ml
ppx lib/y.pp.ml
ocamlmklib lib/dllx_stubs.so,lib/libx_stubs.a
ppx bin/technologic.pp.ml
ppx bin/z.pp.ml
ocamlopt lib/x__.{cmx,o}
ocamldep bin/technologic.depends.ocamldep-output
ocamldep lib/x.depends.ocamldep-output
ocamldep bin/technologic.depends.ocamldep-output
ocamlc lib/x__Y.{cmi,cmo,cmt}
js_of_ocaml .js/js_of_ocaml/js_of_ocaml.cma.js
js_of_ocaml .js/stdlib/stdlib.cma.js
ocamlc lib/x__Y.{cmi,cmo,cmt}
js_of_ocaml lib/x__Y.cmo.js
ocamlopt lib/x__Y.{cmx,o}
ocamlc lib/x.{cmi,cmo,cmt}
ocamlopt lib/x.{cmx,o}
ocamlc bin/z.{cmi,cmo,cmt}
ocamlc lib/x.cma
ocamlc bin/z.{cmi,cmo,cmt}
ocamlopt lib/x.{a,cmxa}
js_of_ocaml bin/z.cmo.js
ocamlc bin/technologic.{cmi,cmo,cmt}
js_of_ocaml lib/x.cma.js
js_of_ocaml bin/technologic.bc.runtime.js
js_of_ocaml bin/z.cmo.js
ocamlc bin/technologic.{cmi,cmo,cmt}
ocamlopt lib/x.cmxs
js_of_ocaml bin/technologic.cmo.js
jsoo_link bin/technologic.bc.js
@ -34,17 +34,17 @@
fix it
$ $JBUILDER build -j1 --root . bin/technologic.bc.js @install
ocamlc lib/x__.{cmi,cmo,cmt}
ocamlc lib/x__Y.{cmi,cmo,cmt}
ocamlopt lib/x__.{cmx,o}
ocamlc lib/x.{cmi,cmo,cmt}
ocamlc lib/x__Y.{cmi,cmo,cmt}
ocamlopt lib/x__Y.{cmx,o}
ocamlc lib/x.{cmi,cmo,cmt}
ocamlopt lib/x.{cmx,o}
ocamlc lib/x.cma
ocamlc bin/z.{cmi,cmo,cmt}
ocamlopt lib/x.{cmx,o}
ocamlc bin/technologic.{cmi,cmo,cmt}
ocamlopt lib/x.{a,cmxa}
ocamlc bin/technologic.bc
ocamlc bin/technologic.{cmi,cmo,cmt}
ocamlopt lib/x.cmxs
ocamlc bin/technologic.bc
js_of_ocaml bin/technologic.bc.js
$ $NODE ./_build/default/bin/technologic.bc.js
buy it