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
|
|
|
|
2017-02-23 14:58:18 +00:00
|
|
|
type setup =
|
|
|
|
{ build_system : Build_system.t
|
2017-06-05 12:42:13 +00:00
|
|
|
; stanzas : (Path.t * Jbuild.Scope.t * Jbuild.Stanzas.t) list String_map.t
|
2017-02-25 02:38:41 +00:00
|
|
|
; contexts : Context.t list
|
2017-02-24 18:21:22 +00:00
|
|
|
; packages : Package.t String_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 =
|
|
|
|
match String_map.find pkg packages with
|
|
|
|
| None -> Error ()
|
2017-12-21 11:54:00 +00:00
|
|
|
| Some p ->
|
|
|
|
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-22 08:19:26 +00:00
|
|
|
?(use_findlib=true)
|
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 ->
|
|
|
|
String_set.iter set ~f:(fun pkg ->
|
|
|
|
if not (String_map.mem pkg conf.packages) then
|
|
|
|
die "@{<error>Error@}: I don't know about package %s \
|
2017-04-04 15:56:14 +00:00
|
|
|
(passed through --only-packages/--release)%s"
|
2017-03-02 18:21:19 +00:00
|
|
|
pkg (hint pkg (String_map.keys conf.packages))));
|
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
|
|
|
|
Context.create ctx_def ~merlin:(workspace.merlin_context = Some name) ~use_findlib)
|
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) ->
|
2017-03-10 12:32:27 +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
|
|
|
|
| Error () -> die "Unknown package %S" pkg)
|
|
|
|
in
|
2017-03-01 19:19:43 +00:00
|
|
|
match String_map.find "default" setup.stanzas with
|
|
|
|
| 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))
|
2017-03-01 19:19:43 +00:00
|
|
|
~f:(String_map.filter ~f:(fun name _ ->
|
2017-02-26 19:49:54 +00:00
|
|
|
not (String_set.mem name internals))))
|
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 () =
|
2017-02-24 12:20:07 +00:00
|
|
|
Ansi_color.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-07 11:38:21 +00:00
|
|
|
let config = Config.load_user_config_file () in
|
|
|
|
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
|
|
|
|
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
|
|
|
~use_findlib:false
|
|
|
|
~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
|
|
|
|
2017-03-29 15:51:48 +00:00
|
|
|
let setup = setup ~use_findlib:true ~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
|