Cross compilation support
In a host/target setup, all binaries that are built (including preprocessors) are ran using the host *for* building targets. Final target artifacts are compiled using the target toolchain
This commit is contained in:
parent
6e64156913
commit
1ff8a7989c
|
@ -327,23 +327,28 @@ module Unexpanded = struct
|
|||
~map:(fun x -> (x, []))
|
||||
end
|
||||
|
||||
let rec expand dir t ~f : Unresolved.t =
|
||||
let rec expand t ~dir ~map_exe ~f : Unresolved.t =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
let args = List.concat_map args ~f:(E.strings ~dir ~f) in
|
||||
let prog, more_args = E.prog_and_args ~dir ~f prog in
|
||||
let prog =
|
||||
match prog with
|
||||
| Search _ -> prog
|
||||
| This path -> This (map_exe path)
|
||||
in
|
||||
Run (prog, more_args @ args)
|
||||
| Chdir (fn, t) ->
|
||||
let fn = E.path ~dir ~f fn in
|
||||
Chdir (fn, expand fn t ~f)
|
||||
Chdir (fn, expand t ~dir:fn ~map_exe ~f)
|
||||
| Setenv (var, value, t) ->
|
||||
Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
|
||||
expand dir t ~f)
|
||||
expand t ~dir ~map_exe ~f)
|
||||
| Redirect (outputs, fn, t) ->
|
||||
Redirect (outputs, E.path ~dir ~f fn, expand dir t ~f)
|
||||
Redirect (outputs, E.path ~dir ~f fn, expand t ~dir ~map_exe ~f)
|
||||
| Ignore (outputs, t) ->
|
||||
Ignore (outputs, expand dir t ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand dir t ~f))
|
||||
Ignore (outputs, expand t ~dir ~map_exe ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> expand t ~dir ~map_exe ~f))
|
||||
| Echo x -> Echo (E.string ~dir ~f x)
|
||||
| Cat x -> Cat (E.path ~dir ~f x)
|
||||
| Copy (x, y) ->
|
||||
|
@ -406,7 +411,7 @@ module Unexpanded = struct
|
|||
~special:VE.to_prog_and_args
|
||||
end
|
||||
|
||||
let rec partial_expand dir t ~f : Partial.t =
|
||||
let rec partial_expand t ~dir ~map_exe ~f : Partial.t =
|
||||
match t with
|
||||
| Run (prog, args) ->
|
||||
let args =
|
||||
|
@ -419,6 +424,11 @@ module Unexpanded = struct
|
|||
match E.prog_and_args ~dir ~f prog with
|
||||
| Inl (prog, more_args) ->
|
||||
let more_args = List.map more_args ~f:(fun x -> Inl x) in
|
||||
let prog =
|
||||
match prog with
|
||||
| Search _ -> prog
|
||||
| This path -> This (map_exe path)
|
||||
in
|
||||
Run (Inl prog, more_args @ args)
|
||||
| Inr _ as prog ->
|
||||
Run (prog, args)
|
||||
|
@ -427,7 +437,7 @@ module Unexpanded = struct
|
|||
let res = E.path ~dir ~f fn in
|
||||
match res with
|
||||
| Inl dir ->
|
||||
Chdir (res, partial_expand dir t ~f)
|
||||
Chdir (res, partial_expand t ~dir ~map_exe ~f)
|
||||
| Inr fn ->
|
||||
let loc = SW.loc fn in
|
||||
Loc.fail loc
|
||||
|
@ -436,12 +446,12 @@ module Unexpanded = struct
|
|||
end
|
||||
| Setenv (var, value, t) ->
|
||||
Setenv (E.string ~dir ~f var, E.string ~dir ~f value,
|
||||
partial_expand dir t ~f)
|
||||
partial_expand t ~dir ~map_exe ~f)
|
||||
| Redirect (outputs, fn, t) ->
|
||||
Redirect (outputs, E.path ~dir ~f fn, partial_expand dir t ~f)
|
||||
Redirect (outputs, E.path ~dir ~f fn, partial_expand t ~dir ~map_exe ~f)
|
||||
| Ignore (outputs, t) ->
|
||||
Ignore (outputs, partial_expand dir t ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> partial_expand dir t ~f))
|
||||
Ignore (outputs, partial_expand t ~dir ~map_exe ~f)
|
||||
| Progn l -> Progn (List.map l ~f:(fun t -> partial_expand t ~dir ~map_exe ~f))
|
||||
| Echo x -> Echo (E.string ~dir ~f x)
|
||||
| Cat x -> Cat (E.path ~dir ~f x)
|
||||
| Copy (x, y) ->
|
||||
|
@ -525,6 +535,20 @@ type exec_context =
|
|||
}
|
||||
|
||||
let run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to prog args =
|
||||
begin match ectx.context with
|
||||
| None
|
||||
| Some { Context.for_host = None; _ } -> ()
|
||||
| Some ({ Context.for_host = Some host; _ } as target) ->
|
||||
let invalid_prefix prefix =
|
||||
match Path.descendant prog ~of_:(Path.of_string prefix) with
|
||||
| None -> ()
|
||||
| Some _ ->
|
||||
die "Context %s has a host %s.@.It's not possible to execute binary %a \
|
||||
in it.@.@.This is a bug and should be reported upstream."
|
||||
target.name host.name Path.pp prog in
|
||||
invalid_prefix ("_build/" ^ target.name);
|
||||
invalid_prefix ("_build/install/" ^ target.name);
|
||||
end;
|
||||
let stdout_to = get_std_output stdout_to in
|
||||
let stderr_to = get_std_output stderr_to in
|
||||
let env = Context.extend_env ~vars:env_extra ~env:ectx.env in
|
||||
|
|
|
@ -78,15 +78,17 @@ module Unexpanded : sig
|
|||
with type string = (string , String_with_vars.t) either
|
||||
|
||||
val expand
|
||||
: Path.t
|
||||
-> t
|
||||
: t
|
||||
-> dir:Path.t
|
||||
-> map_exe:(Path.t -> Path.t)
|
||||
-> f:(Loc.t -> String.t -> Var_expansion.t option)
|
||||
-> Unresolved.t
|
||||
end
|
||||
|
||||
val partial_expand
|
||||
: Path.t
|
||||
-> t
|
||||
: t
|
||||
-> dir:Path.t
|
||||
-> map_exe:(Path.t -> Path.t)
|
||||
-> f:(Loc.t -> string -> Var_expansion.t option)
|
||||
-> Partial.t
|
||||
end
|
||||
|
|
122
src/gen_rules.ml
122
src/gen_rules.ml
|
@ -1057,12 +1057,21 @@ Add it to your jbuild file to remove this warning.
|
|||
entries
|
||||
in
|
||||
let fn =
|
||||
Path.relative (Path.append ctx.build_dir package_path) (package ^ ".install")
|
||||
Path.relative (Path.append ctx.build_dir package_path)
|
||||
(Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain)
|
||||
in
|
||||
let entries = local_install_rules entries ~package in
|
||||
SC.add_rule sctx
|
||||
(Build.path_set (Install.files entries)
|
||||
>>^ (fun () ->
|
||||
let entries =
|
||||
match ctx.findlib_toolchain with
|
||||
| None -> entries
|
||||
| Some toolchain ->
|
||||
let prefix = Path.of_string (toolchain ^ "-sysroot") in
|
||||
List.map entries
|
||||
~f:(Install.Entry.add_install_prefix ~prefix ~package)
|
||||
in
|
||||
Install.gen_install_file entries)
|
||||
>>>
|
||||
Build.write_file_dyn fn)
|
||||
|
@ -1086,22 +1095,28 @@ Add it to your jbuild file to remove this warning.
|
|||
install_file pkg.path pkg.name stanzas)
|
||||
|
||||
let () =
|
||||
let is_default = Path.basename ctx.build_dir = "default" in
|
||||
String_map.iter (SC.packages sctx)
|
||||
~f:(fun ~key:pkg ~data:{ Package.path = src_path; _ } ->
|
||||
let install_fn = pkg ^ ".install" in
|
||||
let copy_to_src =
|
||||
not ctx.implicit &&
|
||||
match ctx.kind with
|
||||
| Default -> true
|
||||
| Opam _ -> false
|
||||
in
|
||||
if not ctx.implicit then
|
||||
String_map.iter (SC.packages sctx)
|
||||
~f:(fun ~key:pkg ~data:{ Package.path = src_path; _ } ->
|
||||
let install_fn = Utils.install_file ~package:pkg ~findlib_toolchain:ctx.findlib_toolchain in
|
||||
|
||||
let ctx_path = Path.append ctx.build_dir src_path in
|
||||
let ctx_install_alias = Alias.install ~dir:ctx_path in
|
||||
let ctx_install_file = Path.relative ctx_path install_fn in
|
||||
Alias.add_deps (SC.aliases sctx) ctx_install_alias [ctx_install_file];
|
||||
let ctx_path = Path.append ctx.build_dir src_path in
|
||||
let ctx_install_alias = Alias.install ~dir:ctx_path in
|
||||
let ctx_install_file = Path.relative ctx_path install_fn in
|
||||
Alias.add_deps (SC.aliases sctx) ctx_install_alias [ctx_install_file];
|
||||
|
||||
if is_default then begin
|
||||
let src_install_alias = Alias.install ~dir:src_path in
|
||||
let src_install_file = Path.relative src_path install_fn in
|
||||
SC.add_rule sctx (Build.copy ~src:ctx_install_file ~dst:src_install_file);
|
||||
Alias.add_deps (SC.aliases sctx) src_install_alias [src_install_file]
|
||||
end)
|
||||
if copy_to_src then begin
|
||||
let src_install_alias = Alias.install ~dir:src_path in
|
||||
let src_install_file = Path.relative src_path install_fn in
|
||||
SC.add_rule sctx (Build.copy ~src:ctx_install_file ~dst:src_install_file);
|
||||
Alias.add_deps (SC.aliases sctx) src_install_alias [src_install_file]
|
||||
end)
|
||||
end
|
||||
|
||||
let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
||||
|
@ -1116,38 +1131,55 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
|||
String_map.filter packages ~f:(fun _ { Package.name; _ } ->
|
||||
String_set.mem name pkgs)
|
||||
in
|
||||
List.map contexts ~f:(fun context ->
|
||||
Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas ->
|
||||
let stanzas =
|
||||
match only_packages with
|
||||
| None -> stanzas
|
||||
| Some pkgs ->
|
||||
List.map stanzas ~f:(fun (dir, pkgs_ctx, stanzas) ->
|
||||
(dir,
|
||||
pkgs_ctx,
|
||||
List.filter stanzas ~f:(fun stanza ->
|
||||
match (stanza : Stanza.t) with
|
||||
| Library { public = Some { package; _ }; _ }
|
||||
| Alias { package = Some package ; _ }
|
||||
| Install { package; _ } ->
|
||||
String_set.mem package.name pkgs
|
||||
| _ -> true)))
|
||||
in
|
||||
let sctx =
|
||||
Super_context.create
|
||||
~context
|
||||
~aliases
|
||||
~scopes
|
||||
~file_tree
|
||||
~packages
|
||||
~filter_out_optional_stanzas_with_missing_deps
|
||||
~stanzas
|
||||
in
|
||||
let module M = Gen(struct let sctx = sctx end) in
|
||||
(Super_context.rules sctx, (context.name, stanzas)))
|
||||
let sctxs : (string, (Super_context.t * _)) Hashtbl.t = Hashtbl.create 4 in
|
||||
let rec make_sctx (context : Context.t) : (_ * _) Future.t =
|
||||
match Hashtbl.find sctxs context.name with
|
||||
| Some r -> Future.return r
|
||||
| None ->
|
||||
let host =
|
||||
match context.for_host with
|
||||
| None -> Future.return None
|
||||
| Some h -> make_sctx h >>| (fun (sctx, _) -> Some sctx)
|
||||
in
|
||||
let stanzas =
|
||||
Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas ->
|
||||
match only_packages with
|
||||
| None -> stanzas
|
||||
| Some pkgs ->
|
||||
List.map stanzas ~f:(fun (dir, pkgs_ctx, stanzas) ->
|
||||
(dir,
|
||||
pkgs_ctx,
|
||||
List.filter stanzas ~f:(fun stanza ->
|
||||
match (stanza : Stanza.t) with
|
||||
| Library { public = Some { package; _ }; _ }
|
||||
| Alias { package = Some package ; _ }
|
||||
| Install { package; _ } ->
|
||||
String_set.mem package.name pkgs
|
||||
| _ -> true)))
|
||||
in
|
||||
Future.both host stanzas >>| fun (host, stanzas) ->
|
||||
let sctx =
|
||||
Super_context.create
|
||||
?host
|
||||
~context
|
||||
~aliases
|
||||
~scopes
|
||||
~file_tree
|
||||
~packages
|
||||
~filter_out_optional_stanzas_with_missing_deps
|
||||
~stanzas
|
||||
in
|
||||
let module M = Gen(struct let sctx = sctx end) in
|
||||
Hashtbl.add sctxs ~key:context.name ~data:(sctx, stanzas);
|
||||
(sctx, stanzas) in
|
||||
List.map ~f:make_sctx contexts
|
||||
|> Future.all
|
||||
>>| fun l ->
|
||||
let rules, context_names_and_stanzas = List.split l in
|
||||
let rules, context_names_and_stanzas =
|
||||
List.map l ~f:(fun (sctx, stanzas) ->
|
||||
(Super_context.rules sctx, ((Super_context.context sctx).name, stanzas)))
|
||||
|> List.split
|
||||
in
|
||||
Alias.Store.unlink aliases unlink_aliases;
|
||||
(Alias.rules aliases @ List.concat rules,
|
||||
String_map.of_alist_exn context_names_and_stanzas)
|
||||
|
|
|
@ -104,6 +104,7 @@ end
|
|||
create_plugin_wrapper context ~exec_dir:dir ~plugin:file ~wrapper
|
||||
~target:generated_jbuild
|
||||
in
|
||||
let context = Option.value context.for_host ~default:context in
|
||||
let pkgs =
|
||||
List.map requires ~f:(Findlib.find_exn context.findlib
|
||||
~required_by:[Utils.jbuild_name_in ~dir:dir])
|
||||
|
|
|
@ -57,6 +57,7 @@ type t =
|
|||
; ppx_drivers : (string, Path.t) Hashtbl.t
|
||||
; external_dirs : (Path.t, External_dir.t) Hashtbl.t
|
||||
; chdir : (Action.t, Action.t) Build.t
|
||||
; host : t option
|
||||
}
|
||||
|
||||
let context t = t.context
|
||||
|
@ -69,6 +70,8 @@ let rules t = t.rules
|
|||
let stanzas_to_consider_for_install t = t.stanzas_to_consider_for_install
|
||||
let cxx_flags t = t.cxx_flags
|
||||
|
||||
let host_sctx t = Option.value t.host ~default:t
|
||||
|
||||
let expand_var_no_root t var = String_map.find var t.vars
|
||||
|
||||
let get_external_dir t ~dir =
|
||||
|
@ -87,6 +90,7 @@ let resolve_program t ?hint bin =
|
|||
|
||||
let create
|
||||
~(context:Context.t)
|
||||
?host
|
||||
~aliases
|
||||
~scopes
|
||||
~file_tree
|
||||
|
@ -186,6 +190,7 @@ let create
|
|||
| Error _ -> assert false
|
||||
in
|
||||
{ context
|
||||
; host
|
||||
; libs
|
||||
; stanzas
|
||||
; packages
|
||||
|
@ -505,7 +510,17 @@ module Action = struct
|
|||
acc.sdeps <- Pset.add path acc.sdeps;
|
||||
Some (path_exp path)
|
||||
|
||||
let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user t =
|
||||
let map_exe sctx =
|
||||
match sctx.host with
|
||||
| None -> (fun exe -> exe)
|
||||
| Some host ->
|
||||
fun exe ->
|
||||
match Path.extract_build_context_dir exe with
|
||||
| Some (dir, exe) when dir = sctx.context.build_dir ->
|
||||
Path.append host.context.build_dir exe
|
||||
| _ -> exe
|
||||
|
||||
let expand_step1 sctx ~dir ~dep_kind ~scope ~targets_written_by_user ~map_exe t =
|
||||
let acc =
|
||||
{ failures = []
|
||||
; lib_deps = String_map.empty
|
||||
|
@ -514,14 +529,17 @@ module Action = struct
|
|||
}
|
||||
in
|
||||
let t =
|
||||
U.partial_expand dir t ~f:(fun loc key ->
|
||||
U.partial_expand t ~dir ~map_exe ~f:(fun loc key ->
|
||||
let open Action.Var_expansion in
|
||||
let cos, var = parse_bang key in
|
||||
match String.lsplit2 var ~on:':' with
|
||||
| Some ("path-no-dep", s) -> Some (path_exp (Path.relative dir s))
|
||||
| Some ("exe" , s) -> static_dep_exp acc (Path.relative dir s)
|
||||
| Some ("exe" , s) ->
|
||||
let exe = map_exe (Path.relative dir s) in
|
||||
static_dep_exp acc exe
|
||||
| Some ("path" , s) -> static_dep_exp acc (Path.relative dir s)
|
||||
| Some ("bin" , s) -> begin
|
||||
let sctx = host_sctx sctx in
|
||||
match Artifacts.binary (artifacts sctx) s with
|
||||
| Ok path ->
|
||||
static_dep_exp acc path
|
||||
|
@ -539,6 +557,7 @@ module Action = struct
|
|||
| Error fail -> add_fail acc fail
|
||||
end
|
||||
| Some ("libexec" , s) -> begin
|
||||
let sctx = host_sctx sctx in
|
||||
let lib_dep, res =
|
||||
Artifacts.file_of_lib (artifacts sctx) ~loc ~from:dir s in
|
||||
add_lib_dep acc lib_dep dep_kind;
|
||||
|
@ -612,9 +631,9 @@ module Action = struct
|
|||
in
|
||||
(t, acc)
|
||||
|
||||
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user t =
|
||||
let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
|
||||
let open Action.Var_expansion in
|
||||
U.Partial.expand dir t ~f:(fun _loc key ->
|
||||
U.Partial.expand t ~dir ~map_exe ~f:(fun _loc key ->
|
||||
match String_map.find key dynamic_expansions with
|
||||
| Some _ as opt -> opt
|
||||
| None ->
|
||||
|
@ -633,9 +652,10 @@ module Action = struct
|
|||
|
||||
let run sctx t ~dir ~dep_kind ~targets:targets_written_by_user ~scope
|
||||
: (Path.t list, Action.t) Build.t =
|
||||
let map_exe = map_exe sctx in
|
||||
let t, forms =
|
||||
expand_step1 sctx t ~dir ~dep_kind ~scope
|
||||
~targets_written_by_user
|
||||
~targets_written_by_user ~map_exe
|
||||
in
|
||||
let { Action.Infer.Outcome. deps; targets } =
|
||||
match targets_written_by_user with
|
||||
|
@ -689,9 +709,10 @@ module Action = struct
|
|||
String_map.add acc ~key:var ~data:value)
|
||||
in
|
||||
let unresolved =
|
||||
expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user
|
||||
expand_step2 t ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe
|
||||
in
|
||||
Action.Unresolved.resolve unresolved ~f:(fun prog ->
|
||||
let sctx = host_sctx sctx in
|
||||
match Artifacts.binary sctx.artifacts prog with
|
||||
| Ok path -> path
|
||||
| Error fail -> Action.Prog.Not_found.raise fail))
|
||||
|
@ -818,6 +839,7 @@ module PP = struct
|
|||
| [] -> "+none+"
|
||||
| _ -> String.concat names ~sep:"+"
|
||||
in
|
||||
let sctx = host_sctx sctx in
|
||||
match Hashtbl.find sctx.ppx_drivers key with
|
||||
| Some x -> x
|
||||
| None ->
|
||||
|
|
|
@ -22,6 +22,7 @@ type t
|
|||
|
||||
val create
|
||||
: context:Context.t
|
||||
-> ?host:t
|
||||
-> aliases:Alias.Store.t
|
||||
-> scopes:Scope.t list
|
||||
-> file_tree:File_tree.t
|
||||
|
|
Loading…
Reference in New Issue