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

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:
Rudi Grinberg 2017-12-21 19:57:45 +08:00
parent 6e64156913
commit 1ff8a7989c
6 changed files with 150 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
src/action.ml
View File

@ -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

10
src/action.mli
View File

@ -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
View File

@ -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)

1
src/jbuild_load.ml
View File

@ -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])

36
src/super_context.ml
View File

@ -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 ->

1
src/super_context.mli
View File

@ -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