2016-11-13 12:25:45 +00:00
|
|
|
open Import
|
2018-02-06 14:39:03 +00:00
|
|
|
open Fiber.O
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2018-02-27 19:06:12 +00:00
|
|
|
let () = Inline_tests.linkme
|
|
|
|
|
2017-02-23 14:58:18 +00:00
|
|
|
type setup =
|
|
|
|
{ build_system : Build_system.t
|
2018-02-20 11:46:10 +00:00
|
|
|
; stanzas : (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list String_map.t
|
2017-02-25 02:38:41 +00:00
|
|
|
; contexts : Context.t list
|
2018-03-02 18:44:03 +00:00
|
|
|
; packages : Package.t Package.Name.Map.t
|
2017-09-29 15:06:29 +00:00
|
|
|
; file_tree : File_tree.t
|
2017-02-23 14:58:18 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
let package_install_file { packages; _ } pkg =
|
2018-03-02 18:44:03 +00:00
|
|
|
match Package.Name.Map.find packages pkg with
|
2017-02-23 14:58:18 +00:00
|
|
|
| None -> Error ()
|
2017-12-21 11:54:00 +00:00
|
|
|
| Some p ->
|
2018-02-25 16:35:25 +00:00
|
|
|
Ok (Path.relative p.path
|
|
|
|
(Utils.install_file ~package:p.name ~findlib_toolchain:None))
|
2017-02-23 14:58:18 +00:00
|
|
|
|
2018-01-19 08:50:06 +00:00
|
|
|
let setup ?(log=Log.no_log)
|
2017-11-28 11:03:22 +00:00
|
|
|
?filter_out_optional_stanzas_with_missing_deps
|
2017-03-01 13:25:18 +00:00
|
|
|
?workspace ?(workspace_file="jbuild-workspace")
|
2017-03-29 15:51:48 +00:00
|
|
|
?only_packages
|
|
|
|
?extra_ignored_subtrees
|
2017-12-21 11:54:00 +00:00
|
|
|
?x
|
2018-01-25 19:07:46 +00:00
|
|
|
?ignore_promoted_rules
|
2017-03-29 15:51:48 +00:00
|
|
|
() =
|
2018-01-25 19:07:46 +00:00
|
|
|
let conf = Jbuild_load.load ?extra_ignored_subtrees ?ignore_promoted_rules () in
|
2017-03-02 18:21:19 +00:00
|
|
|
Option.iter only_packages ~f:(fun set ->
|
2018-03-02 18:44:03 +00:00
|
|
|
Package.Name.Set.iter set ~f:(fun pkg ->
|
|
|
|
if not (Package.Name.Map.mem conf.packages pkg) then
|
2018-03-03 13:41:29 +00:00
|
|
|
let pkg_name = Package.Name.to_string pkg in
|
2017-03-02 18:21:19 +00:00
|
|
|
die "@{<error>Error@}: I don't know about package %s \
|
2017-04-04 15:56:14 +00:00
|
|
|
(passed through --only-packages/--release)%s"
|
2018-03-03 13:41:29 +00:00
|
|
|
pkg_name
|
|
|
|
(hint pkg_name
|
|
|
|
(Package.Name.Map.keys conf.packages
|
|
|
|
|> List.map ~f:Package.Name.to_string))));
|
2017-02-25 02:38:41 +00:00
|
|
|
let workspace =
|
|
|
|
match workspace with
|
|
|
|
| Some w -> w
|
|
|
|
| None ->
|
2017-02-27 15:04:49 +00:00
|
|
|
if Sys.file_exists workspace_file then
|
2017-12-21 11:54:00 +00:00
|
|
|
Workspace.load ?x workspace_file
|
2017-02-25 02:38:41 +00:00
|
|
|
else
|
2017-12-21 11:54:00 +00:00
|
|
|
{ merlin_context = Some "default"
|
|
|
|
; contexts = [Default [
|
|
|
|
match x with
|
|
|
|
| None -> Native
|
|
|
|
| Some x -> Named x
|
|
|
|
]]
|
|
|
|
}
|
2017-02-25 02:38:41 +00:00
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.parallel_map workspace.contexts ~f:(fun ctx_def ->
|
|
|
|
let name = Workspace.Context.name ctx_def in
|
2018-03-06 14:56:24 +00:00
|
|
|
Context.create ctx_def ~merlin:(workspace.merlin_context = Some name))
|
2017-02-25 00:28:10 +00:00
|
|
|
>>= fun contexts ->
|
2017-12-21 11:54:00 +00:00
|
|
|
let contexts = List.concat contexts in
|
|
|
|
List.iter contexts ~f:(fun (ctx : Context.t) ->
|
2018-03-06 14:56:24 +00:00
|
|
|
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp
|
|
|
|
(Context.sexp_of_t ctx));
|
2018-02-07 11:38:21 +00:00
|
|
|
let rule_done = ref 0 in
|
|
|
|
let rule_total = ref 0 in
|
|
|
|
let gen_status_line () =
|
|
|
|
Some (sprintf "Done: %u/%u" !rule_done !rule_total)
|
|
|
|
in
|
|
|
|
let hook (hook : Build_system.hook) =
|
|
|
|
match hook with
|
|
|
|
| Rule_started -> incr rule_total
|
|
|
|
| Rule_completed -> incr rule_done
|
|
|
|
in
|
2018-01-19 08:50:06 +00:00
|
|
|
let build_system =
|
2018-02-07 11:38:21 +00:00
|
|
|
Build_system.create ~contexts ~file_tree:conf.file_tree ~hook
|
2018-01-19 08:50:06 +00:00
|
|
|
in
|
2017-12-21 11:54:00 +00:00
|
|
|
Gen_rules.gen conf
|
2018-01-19 08:50:06 +00:00
|
|
|
~build_system
|
2017-12-21 11:54:00 +00:00
|
|
|
~contexts
|
2017-03-02 18:21:19 +00:00
|
|
|
?only_packages
|
2017-02-26 19:49:54 +00:00
|
|
|
?filter_out_optional_stanzas_with_missing_deps
|
2018-01-19 08:50:06 +00:00
|
|
|
>>= fun stanzas ->
|
2018-02-07 11:38:21 +00:00
|
|
|
Scheduler.set_status_line_generator gen_status_line
|
|
|
|
>>>
|
2018-02-06 14:39:03 +00:00
|
|
|
Fiber.return
|
|
|
|
{ build_system
|
|
|
|
; stanzas
|
|
|
|
; contexts
|
|
|
|
; packages = conf.packages
|
|
|
|
; file_tree = conf.file_tree
|
|
|
|
}
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-24 13:08:37 +00:00
|
|
|
let external_lib_deps ?log ~packages () =
|
2018-02-06 14:39:03 +00:00
|
|
|
Scheduler.go ?log
|
2016-12-15 13:00:30 +00:00
|
|
|
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
2017-03-01 19:19:43 +00:00
|
|
|
>>| fun setup ->
|
2017-02-23 14:58:18 +00:00
|
|
|
let install_files =
|
|
|
|
List.map packages ~f:(fun pkg ->
|
|
|
|
match package_install_file setup pkg with
|
|
|
|
| Ok path -> path
|
2018-03-03 13:41:29 +00:00
|
|
|
| Error () -> die "Unknown package %S" (Package.Name.to_string pkg))
|
2017-02-23 14:58:18 +00:00
|
|
|
in
|
2018-02-25 16:35:25 +00:00
|
|
|
match String_map.find setup.stanzas "default" with
|
2017-03-01 19:19:43 +00:00
|
|
|
| None -> die "You need to set a default context to use external-lib-deps"
|
|
|
|
| Some stanzas ->
|
2017-06-02 13:32:05 +00:00
|
|
|
let internals = Jbuild.Stanzas.lib_names stanzas in
|
2017-03-01 19:19:43 +00:00
|
|
|
Path.Map.map
|
2017-09-29 15:06:29 +00:00
|
|
|
(Build_system.all_lib_deps setup.build_system
|
|
|
|
~request:(Build.paths install_files))
|
2018-02-25 16:35:25 +00:00
|
|
|
~f:(String_map.filteri ~f:(fun name _ ->
|
|
|
|
not (String_set.mem internals name))))
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-03-29 15:51:48 +00:00
|
|
|
let ignored_during_bootstrap =
|
|
|
|
Path.Set.of_list
|
|
|
|
(List.map ~f:Path.of_string
|
|
|
|
[ "test"
|
|
|
|
; "example"
|
|
|
|
])
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
(* Called by the script generated by ../build.ml *)
|
|
|
|
let bootstrap () =
|
2018-02-25 16:35:25 +00:00
|
|
|
Colors.setup_err_formatter_colors ();
|
2017-02-21 15:09:58 +00:00
|
|
|
let main () =
|
|
|
|
let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
|
2017-05-07 19:48:10 +00:00
|
|
|
let subst () =
|
2018-02-06 14:39:03 +00:00
|
|
|
Scheduler.go (Watermarks.subst () ~name:"jbuilder");
|
2017-05-07 19:53:40 +00:00
|
|
|
exit 0
|
2017-05-07 19:48:10 +00:00
|
|
|
in
|
2018-02-07 11:38:21 +00:00
|
|
|
let display = ref None in
|
|
|
|
let display_mode =
|
|
|
|
Arg.Symbol
|
|
|
|
(List.map Config.Display.all ~f:fst,
|
|
|
|
fun s ->
|
|
|
|
display := Some (List.assoc s Config.Display.all))
|
|
|
|
in
|
2018-02-07 12:09:24 +00:00
|
|
|
let concurrency = ref None in
|
|
|
|
let set r x = r := Some x in
|
2017-02-24 12:19:02 +00:00
|
|
|
Arg.parse
|
2018-02-07 12:09:24 +00:00
|
|
|
[ "-j" , Int (set concurrency), "JOBS concurrency"
|
|
|
|
; "--dev" , Set Clflags.dev_mode , " set development mode"
|
|
|
|
; "--display" , display_mode , " set the display mode"
|
2018-02-13 17:49:07 +00:00
|
|
|
; "--subst" , Unit subst ,
|
|
|
|
" substitute watermarks in source files"
|
|
|
|
; "--debug-backtraces",
|
|
|
|
Set Clflags.debug_backtraces,
|
|
|
|
" always print exception backtraces"
|
2017-02-24 12:19:02 +00:00
|
|
|
]
|
|
|
|
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
2017-06-08 08:59:43 +00:00
|
|
|
Clflags.debug_dep_path := true;
|
2018-02-15 14:04:00 +00:00
|
|
|
let config =
|
|
|
|
(* Only load the configuration with --dev *)
|
|
|
|
if !Clflags.dev_mode then
|
|
|
|
Config.load_user_config_file ()
|
|
|
|
else
|
|
|
|
Config.default
|
|
|
|
in
|
2018-02-07 11:38:21 +00:00
|
|
|
let config =
|
2018-02-07 12:09:24 +00:00
|
|
|
Config.merge config
|
|
|
|
{ display = !display
|
|
|
|
; concurrency = !concurrency
|
|
|
|
}
|
2018-02-07 11:38:21 +00:00
|
|
|
in
|
2018-02-15 14:04:00 +00:00
|
|
|
let config =
|
|
|
|
Config.adapt_display config
|
2018-02-25 16:35:25 +00:00
|
|
|
~output_is_a_tty:(Lazy.force Colors.stderr_supports_colors)
|
2018-02-15 14:04:00 +00:00
|
|
|
in
|
2018-02-07 11:38:21 +00:00
|
|
|
let log = Log.create ~display:config.display () in
|
|
|
|
Scheduler.go ~log ~config
|
2018-01-19 08:50:06 +00:00
|
|
|
(setup ~log ~workspace:{ merlin_context = Some "default"
|
|
|
|
; contexts = [Default [Native]] }
|
2017-03-29 15:51:48 +00:00
|
|
|
~extra_ignored_subtrees:ignored_during_bootstrap
|
|
|
|
()
|
2017-02-26 20:53:32 +00:00
|
|
|
>>= fun { build_system = bs; _ } ->
|
2018-02-06 14:39:03 +00:00
|
|
|
Build_system.do_build bs
|
2018-01-19 08:50:06 +00:00
|
|
|
~request:(Build.path (Path.of_string "_build/default/jbuilder.install")))
|
2017-02-21 15:09:58 +00:00
|
|
|
in
|
2016-12-02 13:54:32 +00:00
|
|
|
try
|
|
|
|
main ()
|
2018-02-06 14:39:03 +00:00
|
|
|
with
|
|
|
|
| Fiber.Never -> exit 1
|
|
|
|
| exn ->
|
|
|
|
Report_error.report exn;
|
2016-12-02 13:54:32 +00:00
|
|
|
exit 1
|
2017-03-22 08:19:26 +00:00
|
|
|
|
2018-03-06 14:56:24 +00:00
|
|
|
let setup = setup ~extra_ignored_subtrees:Path.Set.empty
|
2017-08-04 07:59:35 +00:00
|
|
|
|
|
|
|
let find_context_exn t ~name =
|
|
|
|
match List.find t.contexts ~f:(fun c -> c.name = name) with
|
|
|
|
| Some ctx -> ctx
|
|
|
|
| None ->
|
2018-02-06 14:39:03 +00:00
|
|
|
die "@{<Error>Error@}: Context %S not found!@." name
|