2016-11-13 12:25:45 +00:00
|
|
|
open Import
|
2016-12-02 13:54:32 +00:00
|
|
|
open Future
|
|
|
|
|
2017-02-23 14:58:18 +00:00
|
|
|
type setup =
|
|
|
|
{ build_system : Build_system.t
|
|
|
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
|
|
|
; context : Context.t
|
2017-02-25 01:45:41 +00:00
|
|
|
; all_contexts : Context.t list
|
2017-02-24 18:21:22 +00:00
|
|
|
; packages : Package.t String_map.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-02-24 18:21:22 +00:00
|
|
|
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
2017-02-23 14:58:18 +00:00
|
|
|
|
2016-12-15 13:00:30 +00:00
|
|
|
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
2016-12-31 15:12:39 +00:00
|
|
|
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
2017-02-25 00:18:01 +00:00
|
|
|
(if Sys.file_exists "jbuild-workspace" then
|
|
|
|
Future.all
|
|
|
|
(List.map (Workspace.load "jbuild-workspace")
|
|
|
|
~f:(fun { Workspace.Context. name; switch; root } ->
|
|
|
|
Context.create_for_opam ~name ~switch ?root ()))
|
|
|
|
else
|
2017-02-25 00:28:10 +00:00
|
|
|
return [])
|
|
|
|
>>= fun contexts ->
|
|
|
|
(match List.find contexts ~f:(fun c -> c.name = "default") with
|
|
|
|
| None -> Lazy.force Context.default
|
|
|
|
| Some c -> return c)
|
|
|
|
>>= fun default_context ->
|
2016-12-15 13:00:30 +00:00
|
|
|
let rules =
|
2017-02-25 01:33:37 +00:00
|
|
|
Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
|
|
|
?filter_out_optional_stanzas_with_missing_deps ()
|
2016-12-15 13:00:30 +00:00
|
|
|
in
|
2017-02-23 14:58:18 +00:00
|
|
|
let build_system = Build_system.create ~file_tree ~rules in
|
|
|
|
return { build_system
|
|
|
|
; stanzas
|
2017-02-25 00:28:10 +00:00
|
|
|
; context = default_context
|
2017-02-25 01:45:41 +00:00
|
|
|
; all_contexts = contexts
|
2017-02-23 14:58:18 +00:00
|
|
|
; packages
|
|
|
|
}
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-24 13:08:37 +00:00
|
|
|
let external_lib_deps ?log ~packages () =
|
2017-02-23 11:45:03 +00:00
|
|
|
Future.Scheduler.go ?log
|
2016-12-15 13:00:30 +00:00
|
|
|
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
2017-02-23 14:58:18 +00:00
|
|
|
>>| fun ({ build_system = bs; stanzas; _ } as setup) ->
|
|
|
|
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
|
2016-12-15 11:20:46 +00:00
|
|
|
Path.Map.map
|
2017-02-23 14:58:18 +00:00
|
|
|
(Build_system.all_lib_deps bs install_files)
|
2016-12-15 13:00:30 +00:00
|
|
|
~f:(fun deps ->
|
|
|
|
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
|
|
|
String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
|
2016-12-02 13:54:32 +00:00
|
|
|
|
|
|
|
let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
|
|
|
match exn with
|
2016-11-13 12:32:12 +00:00
|
|
|
| Loc.Error ({ start; stop }, msg) ->
|
|
|
|
let start_c = start.pos_cnum - start.pos_bol in
|
|
|
|
let stop_c = stop.pos_cnum - start.pos_bol in
|
2016-12-02 13:54:32 +00:00
|
|
|
Format.fprintf ppf
|
2017-02-24 11:16:55 +00:00
|
|
|
"@{<loc>File \"%s\", line %d, characters %d-%d:@}\n\
|
|
|
|
@{<error>Error@}: %s\n"
|
2016-12-02 13:54:32 +00:00
|
|
|
(map_fname start.pos_fname) start.pos_lnum start_c stop_c msg
|
2017-02-23 11:55:14 +00:00
|
|
|
| Fatal_error "" -> ()
|
2016-12-02 13:54:32 +00:00
|
|
|
| Fatal_error msg ->
|
|
|
|
Format.fprintf ppf "%s\n" (String.capitalize msg)
|
|
|
|
| Findlib.Package_not_found pkg ->
|
2017-02-24 11:28:30 +00:00
|
|
|
Format.fprintf ppf "@{<error>Findlib package %S not found.@}\n" pkg
|
2016-12-02 13:54:32 +00:00
|
|
|
| Code_error msg ->
|
|
|
|
let bt = Printexc.raw_backtrace_to_string backtrace in
|
2017-02-24 11:28:30 +00:00
|
|
|
Format.fprintf ppf "@{<error>Internal error, please report upstream.@}\n\
|
2016-12-02 13:54:32 +00:00
|
|
|
Description: %s\n\
|
|
|
|
Backtrace:\n\
|
|
|
|
%s" msg bt
|
|
|
|
| _ ->
|
|
|
|
let s = Printexc.to_string exn in
|
|
|
|
let bt = Printexc.raw_backtrace_to_string backtrace in
|
|
|
|
if String.is_prefix s ~prefix:"File \"" then
|
|
|
|
Format.fprintf ppf "%s\nBacktrace:\n%s" s bt
|
|
|
|
else
|
2017-02-24 11:28:30 +00:00
|
|
|
Format.fprintf ppf "@{<error>Error@}: exception %s\nBacktrace:\n%s" s bt
|
2016-11-13 12:32:12 +00:00
|
|
|
|
2016-12-02 13:54:32 +00:00
|
|
|
let report_error ?map_fname ppf exn =
|
|
|
|
match exn with
|
|
|
|
| Build_system.Build_error.E err ->
|
|
|
|
let module E = Build_system.Build_error in
|
|
|
|
report_error ?map_fname ppf (E.exn err) ~backtrace:(E.backtrace err);
|
|
|
|
if !Clflags.debug_dep_path then
|
|
|
|
Format.fprintf ppf "Dependency path:\n %s\n"
|
|
|
|
(String.concat ~sep:"\n--> "
|
|
|
|
(List.map (E.dependency_path err) ~f:Path.to_string))
|
|
|
|
| exn ->
|
|
|
|
let backtrace = Printexc.get_raw_backtrace () in
|
|
|
|
report_error ?map_fname ppf exn ~backtrace
|
|
|
|
|
2017-02-23 11:45:03 +00:00
|
|
|
let create_log () =
|
|
|
|
if not (Sys.file_exists "_build") then
|
|
|
|
Unix.mkdir "_build" 0o777;
|
|
|
|
let oc = open_out_bin "_build/log" in
|
|
|
|
Printf.fprintf oc "# %s\n%!"
|
|
|
|
(String.concat (List.map (Array.to_list Sys.argv) ~f:quote_for_shell) ~sep:" ");
|
|
|
|
oc
|
|
|
|
|
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 pkg = "jbuilder" in
|
|
|
|
let main () =
|
|
|
|
let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
|
2017-02-24 12:19:02 +00:00
|
|
|
Arg.parse
|
|
|
|
[ "-j" , Set_int Clflags.concurrency, "JOBS concurrency"
|
|
|
|
; "--dev", Set Clflags.dev_mode , " set development mode"
|
|
|
|
]
|
|
|
|
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
2017-02-23 11:45:03 +00:00
|
|
|
Future.Scheduler.go ~log:(create_log ())
|
2017-02-23 14:58:18 +00:00
|
|
|
(setup () >>= fun { build_system = bs; _ } ->
|
2017-02-21 15:09:58 +00:00
|
|
|
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
|
|
|
in
|
2016-12-02 13:54:32 +00:00
|
|
|
try
|
|
|
|
main ()
|
|
|
|
with exn ->
|
|
|
|
Format.eprintf "%a@?" (report_error ?map_fname:None) exn;
|
|
|
|
exit 1
|