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

Merge pull request #380 from rgrinberg/yy 

Cross Compilation
This commit is contained in:
Rudi Grinberg 2018-01-01 22:47:44 +08:00 committed by GitHub
parent 1de1ced82b f68c1dd042
commit 5cb909bb80
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
38 changed files with 866 additions and 367 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
CHANGES.md
View File

@ -19,7 +19,7 @@ next
absolute path but with the context's environment set appropriately. Lastly,
`jbuilder exec` will change the root as to which paths are relative using the
`-root` option. (#286)
- Fix `jbuilder rules` printing rules when some binaries are missing (#292)
- Build documentation for non public libraries (#306)
@ -28,6 +28,11 @@ next
- Fix copy# for C/C++ with Microsoft C compiler (#353)
- Add support for cross-compilation. Currently we are supporting the
opam-cross-x repositories such as
[opam-cross-windows](https://github.com/whitequark/opam-cross-windows)
(#355)
1.0+beta16 (05/11/2017)
-----------------------

17
bin/main.ml
View File

@ -21,6 +21,7 @@ type common =
; target_prefix : string
; only_packages : String_set.t option
; capture_outputs : bool
; x : string option
; (* Original arguments for the external-lib-deps hint *)
orig_args : string list
}
@ -74,7 +75,9 @@ module Main = struct
?unlink_aliases
?workspace_file:common.workspace_file
?only_packages:common.only_packages
?filter_out_optional_stanzas_with_missing_deps ()
?filter_out_optional_stanzas_with_missing_deps
?x:common.x
()
end
type target =
@ -154,6 +157,7 @@ let common =
no_buffer
workspace_file
(root, only_packages, orig)
x
=
let root, to_cwd =
match root with
@ -181,6 +185,7 @@ let common =
; only_packages =
Option.map only_packages
~f:(fun s -> String_set.of_list (String.split s ~on:','))
; x
}
in
let docs = copts_sect in
@ -304,6 +309,12 @@ let common =
$ only_packages
$ frop))
in
let x =
Arg.(value
& opt (some string) None
& info ["x"] ~docs
~doc:{|Cross-compile using this toolchain.|})
in
Term.(const make
$ concurrency
$ ddep_path
@ -314,6 +325,7 @@ let common =
$ no_buffer
$ workspace_file
$ root_and_only_packages
$ x
)
let installed_libraries =
@ -321,7 +333,8 @@ let installed_libraries =
let go common na =
set_common common ~targets:[];
Future.Scheduler.go ~log:(Log.create ())
(Context.default () >>= fun ctx ->
(Context.create (Default [Native]) >>= fun ctxs ->
let ctx = List.hd ctxs in
let findlib = ctx.findlib in
if na then begin
let pkgs = Findlib.all_unavailable_packages findlib in

93
doc/advanced-topics.rst
View File

@ -102,6 +102,99 @@ set of predicates:
it is linked as part of a driver or meant to add a ``-ppx`` argument
to the compiler, choose the former behavior
Cross Compilation
=================
Jbuilder allows for cross compilation by defining build contexts with
multiple targets. Targets are specified by adding a ``targets`` field
to the definition of a build context.
``targets`` takes a list of target name. It can be either:
- ``native`` which means using the native tools that can build
binaries that run on the machine doing the build
- the name of an alternative toolchain
Note that at the moment, there is no official support for
cross-compilation in OCaml. Jbuilder supports the two following
opam-cross-x repositories:
- `opam-cross-windows <https://github.com/whitequark/opam-cross-windows>`_
- `opam-cross-android <https://github.com/whitequark/opam-cross-android>`_
To build Windows binaries using opam-cross-windows, write ``windows``
in the list of targets. To build Android binaries using
opam-cross-android, write ``android`` in the list of targets.
For example, the following workspace file defines three different
targets for the ``default`` build context:
.. code:: scheme
(context (default (targets (native windows android))))
This configuration defines three build contexts:
- ``default``
- ``default.windows``
- ``default.android``
Note that the ``native`` target is always implicitly added when not
present. However, when implicitly added ``jbuilder build @install``
will skip this context, i.e. ``default`` will only be used for
building executables needed by the other contexts.
With such a setup, calling ``jbuilder build @install`` will build all
the packages three times.
Note that instead of writing a ``jbuild-workspace`` file, you can also
use the ``-x`` command line option. Passing ``-x foo`` to ``jbuilder``
without having a ``jbuild-workspace`` file is the same as writing the
following ``jbuild-workspace`` file:
.. code:: scheme
(context (default (targets (foo))))
If you have a ``jbuild-workspace`` and pass a ``-x foo`` option,
``foo`` will be added as target of all context stanzas.
How does it work?
-----------------
In such a setup, binaries that need to be built and executed in the
``default.windows`` or ``default.android`` contexts as part of the
build, will no longer be executed. Instead, all the binaries that will
be executed will come from the ``default`` context. One consequence of
this is that all preprocessing (ppx or otherwise) will be done using
binaries built in the ``default`` context.
To clarify this with an example, let's assume that you have the
following ``src/jbuild`` file:
.. code:: scheme
(executable ((name foo)))
(rule (with-stdout-to blah (run ./foo.exe)))
When building ``_build/default/src/blah``, jbuilder will resolve ``./foo.exe`` to
``_build/default/src/foo.exe`` as expected. However, for
``_build/default.windows/src/blah`` jbuilder will resolve ``./foo.exe`` to
``_build/default/src/foo.exe``
Assuming that the right packages are installed or that your workspace
has no external dependencies, jbuilder will be able to cross-compile a
given package without doing anything special.
Some packages might still have to be updated to support cross-compilation. For
instance if the ``foo.exe`` program in the previous example was using
``Sys.os_type``, it should instead take it as a command line argument:
.. code:: scheme
(rule (with-stdout-to blah (run ./foo.exe -os-type ${os_type})))
Classical ppx
=============

27
doc/usage.rst
View File

@ -334,9 +334,9 @@ a typical ``jbuild-workspace`` file looks like:
.. code:: scheme
(context ((switch 4.02.3)))
(context ((switch 4.03.0)))
(context ((switch 4.04.0)))
(context (opam (switch 4.02.3)))
(context (opam (switch 4.03.0)))
(context (opam (switch 4.04.0)))
The rest of this section describe the stanzas available.
@ -354,13 +354,13 @@ context
~~~~~~~
The ``(context ...)`` stanza declares a build context. The argument
can be either ``default`` for the default build context or can be the
description of an opam switch, as follows:
can be either ``default`` or ``(default)`` for the default build
context or can be the description of an opam switch, as follows:
.. code:: scheme
(context ((switch <opam-switch-name>)
<optional-fields>))
(context (opam (switch <opam-switch-name>)
<optional-fields>))
``<optional-fields>`` are:
@ -374,6 +374,10 @@ description of an opam switch, as follows:
- ``(merlin)`` instructs Jbuilder to use this build context for
merlin
Both ``(default ...)`` and ``(opam ...)`` accept a ``targets`` field
in order to setup cross compilation. See `Cross Compilation`_ for more
information.
Merlin reads compilation artifacts and it can only read the
compilation artifacts of a single context. Usually, you should use
the artifacts from the ``default`` context, and if you have the
@ -384,6 +388,15 @@ For rare cases where this is not what you want, you can force Jbuilder
to use a different build contexts for merlin by adding the field
``(merlin)`` to this context.
Note that the following syntax is still accepted but is deprecated:
.. code:: scheme
(context ((switch <opam-switch-name>)
<optional-fields>))
it is interpreted the same as ``(context (opam (switch ...) ...))``.
Building JavaScript with js_of_ocaml
====================================

12
jbuild-workspace.dev
View File

@ -1,7 +1,7 @@
;; This file is used by `make all-supported-ocaml-versions`
(context ((switch 4.02.3)))
(context ((switch 4.03.0)))
(context ((switch 4.04.2)))
(context ((switch 4.05.0)))
(context ((switch 4.06.0)))
(context ((switch 4.07.0+trunk)))
(context (opam (switch 4.02.3)))
(context (opam (switch 4.03.0)))
(context (opam (switch 4.04.2)))
(context (opam (switch 4.05.0)))
(context (opam (switch 4.06.0)))
(context (opam (switch 4.07.0+trunk)))

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

450
src/context.ml
View File

@ -34,6 +34,7 @@ type t =
; kind : Kind.t
; merlin : bool
; for_host : t option
; implicit : bool
; build_dir : Path.t
; path : Path.t list
; toplevel_path : Path.t option
@ -46,6 +47,7 @@ type t =
; env : string array
; env_extra : string Env_var_map.t
; findlib : Findlib.t
; findlib_toolchain : string option
; arch_sixtyfour : bool
; opam_var_cache : (string, string) Hashtbl.t
; natdynlink_supported : bool
@ -175,7 +177,8 @@ let extend_env ~vars ~env =
imported
|> Array.of_list
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin ~use_findlib =
let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin
~use_findlib ~targets () =
let env = extend_env ~env:base_env ~vars:env_extra in
let opam_var_cache = Hashtbl.create 128 in
(match kind with
@ -187,195 +190,258 @@ let create ~(kind : Kind.t) ~path ~base_env ~env_extra ~name ~merlin ~use_findli
in
let which_cache = Hashtbl.create 128 in
let which x = which ~cache:which_cache ~path x in
let ocamlc =
match which "ocamlc" with
| None -> prog_not_found_in_path "ocamlc"
| Some x -> x
let findlib_config_path = lazy (
match which "ocamlfind" with
| None -> prog_not_found_in_path "ocamlfind"
| Some fn ->
(* When OCAMLFIND_CONF is set, "ocamlfind printconf" does print the contents of the
variable, but "ocamlfind printconf conf" still prints the configuration file set
at the configuration time of ocamlfind, sigh... *)
match Sys.getenv "OCAMLFIND_CONF" with
| s -> Future.return (Path.absolute s)
| exception Not_found ->
Future.run_capture_line ~env Strict
(Path.to_string fn) ["printconf"; "conf"]
>>| Path.absolute)
in
let dir = Path.parent ocamlc in
let prog_not_found prog =
die "ocamlc found in %s, but %s/%s doesn't exist (context: %s)"
(Path.to_string dir) (Path.to_string dir) prog name
in
let best_prog prog = Bin.best_prog dir prog in
let get_prog prog =
match best_prog prog with
| None -> prog_not_found prog
| Some fn -> fn
in
let build_dir =
Path.of_string (sprintf "_build/%s" name)
in
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
let findlib_path =
if use_findlib then
(* If ocamlfind is present, it has precedence over everything else. *)
match which "ocamlfind" with
| Some fn ->
(Future.run_capture_lines ~env Strict
(Path.to_string fn) ["printconf"; "path"]
>>| List.map ~f:Path.absolute)
| None ->
(* If there no ocamlfind in the PATH, check if we have opam and assume a stan opam
setup *)
opam_config_var ~env ~cache:opam_var_cache "lib"
>>| function
| Some s -> [Path.absolute s]
| None ->
(* If neither opam neither ocamlfind are present, assume that libraries are
[dir ^ "/../lib"] *)
[Path.relative (Path.parent dir) "lib"]
else
return []
in
both
findlib_path
(Future.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"])
>>= fun (findlib_path, ocamlc_config) ->
let ocamlc_config =
List.map ocamlc_config ~f:(fun line ->
match String.index line ':' with
| Some i ->
(String.sub line ~pos:0 ~len:i,
String.sub line ~pos:(i + 2) ~len:(String.length line - i - 2))
| None ->
die "unrecognized line in the output of `%s`: %s" ocamlc_config_cmd
line)
|> String_map.of_alist
|> function
| Ok x -> x
| Error (key, _, _) ->
die "variable %S present twice in the output of `%s`" key ocamlc_config_cmd
in
let get_opt var = String_map.find var ocamlc_config in
let get ?default var =
match get_opt var with
| Some s -> s
| None ->
match default with
let create_one ~name ~implicit ?findlib_toolchain ?host ~merlin () =
(match findlib_toolchain with
| None -> Future.return None
| Some toolchain ->
Lazy.force findlib_config_path >>| fun path ->
Some (Findlib.Config.load path ~toolchain ~context:name))
>>= fun findlib_config ->
let get_tool_using_findlib_config prog =
match findlib_config with
| None -> None
| Some conf ->
match Findlib.Config.get conf prog with
| "" -> None
| s ->
match Filename.analyze_program_name s with
| In_path | Relative_to_current_dir -> which s
| Absolute -> Some (Path.absolute s)
in
let ocamlc =
match get_tool_using_findlib_config "ocamlc" with
| Some x -> x
| None ->
die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
in
let get_bool ?default var =
match get ?default:(Option.map default ~f:string_of_bool) var with
| "true" -> true
| "false" -> false
| _ -> die "variable %S is neither 'true' neither 'false' in the output of `%s`"
var ocamlc_config_cmd
in
let get_path var = Path.absolute (get var) in
let stdlib_dir = get_path "standard_library" in
let natdynlink_supported = Path.exists (Path.relative stdlib_dir "dynlink.cmxa") in
let version = get "version" in
let env,env_extra =
(* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05,
OCAML_COLOR is not supported so we use OCAMLPARAM. OCaml 4.02 doesn't support
'color' in OCAMLPARAM, so we just don't force colors with 4.02. *)
let ocaml_version = Scanf.sscanf version "%u.%u" (fun a b -> a, b) in
if !Clflags.capture_outputs
&& Lazy.force Ansi_color.stderr_supports_colors
&& ocaml_version > (4, 02)
&& ocaml_version < (4, 05) then
let value =
match get_env env "OCAMLPARAM" with
| None -> "color=always,_"
| Some s -> "color=always," ^ s
in
extend_env ~env ~vars:((Env_var_map.singleton "OCAMLPARAM" value)),
(Env_var_map.add ~key:"OCAMLPARAM" ~data:value env_extra)
else
env,env_extra
in
let c_compiler, ocamlc_cflags, ocamlopt_cflags =
match get_opt "c_compiler" with
| Some c_compiler -> (* >= 4.06 *)
(c_compiler, get "ocamlc_cflags", get "ocamlopt_cflags")
| None ->
let split_prog s =
let len = String.length s in
let rec loop i =
if i = len then
(s, "")
else
match s.[i] with
| ' ' | '\t' ->
(String.sub s ~pos:0 ~len:i,
String.sub s ~pos:i ~len:(len - i))
| _ -> loop (i + 1)
match which "ocamlc" with
| Some x -> x
| None -> prog_not_found_in_path "ocamlc"
in
let dir = Path.parent ocamlc in
let ocaml_tool_not_found prog =
die "ocamlc found in %s, but %s/%s doesn't exist (context: %s)"
(Path.to_string dir) (Path.to_string dir) prog name
in
let get_ocaml_tool prog =
match get_tool_using_findlib_config prog with
| None -> Bin.best_prog dir prog
| Some _ as x -> x
in
let get_ocaml_tool_exn prog =
match get_ocaml_tool prog with
| None -> ocaml_tool_not_found prog
| Some fn -> fn
in
let build_dir = Path.of_string (sprintf "_build/%s" name) in
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
let findlib_path =
if use_findlib then
(* If ocamlfind is present, it has precedence over everything else. *)
match which "ocamlfind" with
| Some fn ->
let args =
let args = ["printconf"; "path"] in
match findlib_toolchain with
| None -> args
| Some s -> "-toolchain" :: s :: args
in
Future.run_capture_lines ~env Strict (Path.to_string fn) args
>>| List.map ~f:Path.absolute
| None ->
(* If there no ocamlfind in the PATH, check if we have opam
and assume a standard opam setup *)
opam_config_var ~env ~cache:opam_var_cache "lib"
>>| function
| Some s -> [Path.absolute s]
| None ->
(* If neither opam neither ocamlfind are present, assume that libraries are
[dir ^ "/../lib"] *)
[Path.relative (Path.parent dir) "lib"]
else
return []
in
both
findlib_path
(Future.run_capture_lines ~env Strict (Path.to_string ocamlc) ["-config"])
>>= fun (findlib_path, ocamlc_config) ->
let ocamlc_config =
List.map ocamlc_config ~f:(fun line ->
match String.index line ':' with
| Some i ->
(String.sub line ~pos:0 ~len:i,
String.sub line ~pos:(i + 2) ~len:(String.length line - i - 2))
| None ->
die "unrecognized line in the output of `%s`: %s" ocamlc_config_cmd
line)
|> String_map.of_alist
|> function
| Ok x -> x
| Error (key, _, _) ->
die "variable %S present twice in the output of `%s`" key ocamlc_config_cmd
in
let get_opt var = String_map.find var ocamlc_config in
let get ?default var =
match get_opt var with
| Some s -> s
| None ->
match default with
| Some x -> x
| None ->
die "variable %S not found in the output of `%s`" var ocamlc_config_cmd
in
let get_bool ?default var =
match get ?default:(Option.map default ~f:string_of_bool) var with
| "true" -> true
| "false" -> false
| _ -> die "variable %S is neither 'true' neither 'false' in the output of `%s`"
var ocamlc_config_cmd
in
let get_path var = Path.absolute (get var) in
let stdlib_dir = get_path "standard_library" in
let natdynlink_supported = Path.exists (Path.relative stdlib_dir "dynlink.cmxa") in
let version = get "version" in
let env, env_extra =
(* See comment in ansi_color.ml for setup_env_for_colors. For OCaml < 4.05,
OCAML_COLOR is not supported so we use OCAMLPARAM. OCaml 4.02 doesn't support
'color' in OCAMLPARAM, so we just don't force colors with 4.02. *)
let ocaml_version = Scanf.sscanf version "%u.%u" (fun a b -> a, b) in
if !Clflags.capture_outputs
&& Lazy.force Ansi_color.stderr_supports_colors
&& ocaml_version > (4, 02)
&& ocaml_version < (4, 05) then
let value =
match get_env env "OCAMLPARAM" with
| None -> "color=always,_"
| Some s -> "color=always," ^ s
in
loop 0
in
let c_compiler, ocamlc_cflags = split_prog (get "bytecomp_c_compiler") in
let _, ocamlopt_cflags = split_prog (get "native_c_compiler") in
(c_compiler, ocamlc_cflags, ocamlopt_cflags)
extend_env ~env ~vars:((Env_var_map.singleton "OCAMLPARAM" value)),
(Env_var_map.add ~key:"OCAMLPARAM" ~data:value env_extra)
else
env,env_extra
in
let c_compiler, ocamlc_cflags, ocamlopt_cflags =
match get_opt "c_compiler" with
| Some c_compiler -> (* >= 4.06 *)
(c_compiler, get "ocamlc_cflags", get "ocamlopt_cflags")
| None ->
let split_prog s =
let len = String.length s in
let rec loop i =
if i = len then
(s, "")
else
match s.[i] with
| ' ' | '\t' ->
(String.sub s ~pos:0 ~len:i,
String.sub s ~pos:i ~len:(len - i))
| _ -> loop (i + 1)
in
loop 0
in
let c_compiler, ocamlc_cflags = split_prog (get "bytecomp_c_compiler") in
let _, ocamlopt_cflags = split_prog (get "native_c_compiler") in
(c_compiler, ocamlc_cflags, ocamlopt_cflags)
in
let arch_sixtyfour =
match get_opt "word_size" with
| Some ws -> ws = "64"
| None -> get_arch_sixtyfour stdlib_dir
in
return
{ name
; implicit
; kind
; merlin
; for_host = host
; build_dir
; path
; toplevel_path = Option.map (get_env env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
; ocaml_bin = dir
; ocaml = (match which "ocaml" with Some p -> p | None -> prog_not_found_in_path "ocaml")
; ocamlc
; ocamlopt = get_ocaml_tool "ocamlopt"
; ocamldep = get_ocaml_tool_exn "ocamldep"
; ocamlmklib = get_ocaml_tool_exn "ocamlmklib"
; env
; env_extra
; findlib = Findlib.create ~stdlib_dir ~path:findlib_path
; findlib_toolchain
; arch_sixtyfour
; opam_var_cache
; natdynlink_supported
; stdlib_dir
; ocamlc_config = String_map.bindings ocamlc_config
; version
; ccomp_type = get "ccomp_type"
; c_compiler
; ocamlc_cflags
; ocamlopt_cflags
; bytecomp_c_libraries = get "bytecomp_c_libraries"
; native_c_libraries = get "native_c_libraries"
; native_pack_linker = get "native_pack_linker"
; ranlib = get "ranlib"
; cc_profile = get "cc_profile"
; architecture = get "architecture"
; system = get "system"
; ext_obj = get "ext_obj"
; ext_asm = get "ext_asm"
; ext_lib = get "ext_lib"
; ext_dll = get "ext_dll"
; os_type = get "os_type"
; default_executable_name = get "default_executable_name"
; host = get "host"
; target = get "target"
; flambda = get_bool "flambda" ~default:false
; exec_magic_number = get "exec_magic_number"
; cmi_magic_number = get "cmi_magic_number"
; cmo_magic_number = get "cmo_magic_number"
; cma_magic_number = get "cma_magic_number"
; cmx_magic_number = get "cmx_magic_number"
; cmxa_magic_number = get "cmxa_magic_number"
; ast_impl_magic_number = get "ast_impl_magic_number"
; ast_intf_magic_number = get "ast_intf_magic_number"
; cmxs_magic_number = get "cmxs_magic_number"
; cmt_magic_number = get "cmt_magic_number"
; which_cache
}
in
let arch_sixtyfour =
match get_opt "word_size" with
| Some ws -> ws = "64"
| None -> get_arch_sixtyfour stdlib_dir
in
return
{ name
; kind
; merlin
; for_host = None
; build_dir
; path
; toplevel_path = Option.map (get_env env "OCAML_TOPLEVEL_PATH") ~f:Path.absolute
; ocaml_bin = dir
; ocaml = Path.relative dir ("ocaml" ^ Bin.exe)
; ocamlc
; ocamlopt = best_prog "ocamlopt"
; ocamldep = get_prog "ocamldep"
; ocamlmklib = get_prog "ocamlmklib"
; env
; env_extra
; findlib = Findlib.create ~stdlib_dir ~path:findlib_path
; arch_sixtyfour
; opam_var_cache
; natdynlink_supported
; stdlib_dir
; ocamlc_config = String_map.bindings ocamlc_config
; version
; ccomp_type = get "ccomp_type"
; c_compiler
; ocamlc_cflags
; ocamlopt_cflags
; bytecomp_c_libraries = get "bytecomp_c_libraries"
; native_c_libraries = get "native_c_libraries"
; native_pack_linker = get "native_pack_linker"
; ranlib = get "ranlib"
; cc_profile = get "cc_profile"
; architecture = get "architecture"
; system = get "system"
; ext_obj = get "ext_obj"
; ext_asm = get "ext_asm"
; ext_lib = get "ext_lib"
; ext_dll = get "ext_dll"
; os_type = get "os_type"
; default_executable_name = get "default_executable_name"
; host = get "host"
; target = get "target"
; flambda = get_bool "flambda" ~default:false
; exec_magic_number = get "exec_magic_number"
; cmi_magic_number = get "cmi_magic_number"
; cmo_magic_number = get "cmo_magic_number"
; cma_magic_number = get "cma_magic_number"
; cmx_magic_number = get "cmx_magic_number"
; cmxa_magic_number = get "cmxa_magic_number"
; ast_impl_magic_number = get "ast_impl_magic_number"
; ast_intf_magic_number = get "ast_intf_magic_number"
; cmxs_magic_number = get "cmxs_magic_number"
; cmt_magic_number = get "cmt_magic_number"
; which_cache
}
let implicit = not (List.mem ~set:targets Workspace.Context.Target.Native) in
create_one () ~implicit ~name ~merlin >>= fun native ->
Future.all (
List.filter_map targets ~f:(function
| Native -> None
| Named findlib_toolchain ->
let name = sprintf "%s.%s" name findlib_toolchain in
Some (create_one () ~implicit:false ~name ~findlib_toolchain ~host:native
~merlin:false)
)
) >>| fun others ->
native :: others
let opam_config_var t var = opam_config_var ~env:t.env ~cache:t.opam_var_cache var
@ -383,7 +449,7 @@ let initial_env = lazy (
Lazy.force Ansi_color.setup_env_for_colors;
Unix.environment ())
let default ?(merlin=true) ?(use_findlib=true) () =
let default ?(merlin=true) ?(use_findlib=true) ~targets () =
let env = Lazy.force initial_env in
let path =
match get_env env "PATH" with
@ -391,9 +457,9 @@ let default ?(merlin=true) ?(use_findlib=true) () =
| None -> []
in
create ~kind:Default ~path ~base_env:env ~env_extra:Env_var_map.empty
~name:"default" ~merlin ~use_findlib
~name:"default" ~merlin ~use_findlib ~targets ()
let create_for_opam ?root ~switch ~name ?(merlin=false) () =
let create_for_opam ?root ~targets ~switch ~name ?(merlin=false) () =
match Bin.opam with
| None -> Utils.program_not_found "opam"
| Some fn ->
@ -430,8 +496,14 @@ let create_for_opam ?root ~switch ~name ?(merlin=false) () =
| Some s -> Bin.parse_path s
in
let env = Lazy.force initial_env in
create ~kind:(Opam { root; switch }) ~path ~base_env:env ~env_extra:vars
~name ~merlin ~use_findlib:true
create ~kind:(Opam { root; switch }) ~targets
~path ~base_env:env ~env_extra:vars ~name ~merlin ~use_findlib:true ()
let create ?use_findlib ?merlin def =
match (def : Workspace.Context.t) with
| Default targets -> default ~targets ?merlin ?use_findlib ()
| Opam { name; switch; root; targets; _ } ->
create_for_opam ?root ~switch ~name ?merlin ~targets ()
let which t s = which ~cache:t.which_cache ~path:t.path s

19
src/context.mli
View File

@ -48,6 +48,10 @@ type t =
building tools used for the compilation that run on the host. *)
for_host : t option
; (** [false] if a user explicitly listed this context in the workspace.
Controls whether we add artifacts from this context @install *)
implicit : bool
; (** Directory where artifact are stored, for instance "_build/default" *)
build_dir : Path.t
@ -72,6 +76,7 @@ type t =
env_extra : string Env_var_map.t
; findlib : Findlib.t
; findlib_toolchain : string option
; (** Misc *)
arch_sixtyfour : bool
@ -124,18 +129,14 @@ val sexp_of_t : t -> Sexp.t
(** Compare the context names *)
val compare : t -> t -> int
val create_for_opam
: ?root:string
-> switch:string
-> name:string
-> ?merlin:bool
-> unit
-> t Future.t
(** If [use_findlib] is [false], don't try to guess the library search path with opam or
ocamlfind. This is only for building jbuilder itself, so that its build is completely
independent of the user setup. *)
val default : ?merlin:bool -> ?use_findlib:bool -> unit -> t Future.t
val create
: ?use_findlib:bool
-> ?merlin:bool
-> Workspace.Context.t
-> t list Future.t
val which : t -> string -> Path.t option

4
src/file_tree.ml
View File

@ -40,9 +40,7 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) path =
Path.readdir path
|> List.filter_map ~f:(fun fn ->
let path = Path.relative path fn in
let is_directory =
try Path.is_directory path with _ -> false
in
let is_directory = Path.is_directory path in
if ignore_file fn ~is_directory then
None
else if is_directory then

23
src/findlib.ml
View File

@ -118,6 +118,29 @@ module Vars = struct
let get_words t var preds = String.extract_comma_space_separated_words (get t var preds)
end
module Config = struct
type t =
{ vars : Vars.t
; preds : string list
}
let load path ~toolchain ~context =
let path = Path.extend_basename path ~suffix:".d" in
let conf_file = Path.relative path (toolchain ^ ".conf") in
if not (Path.exists conf_file) then
die "@{<error>Error@}: ocamlfind toolchain %s isn't defined in %a \
(context: %s)" toolchain Path.pp path context;
let vars =
(Meta.simplify { name = ""
; entries = Meta.load (Path.to_string conf_file)
}).vars
in
{ vars = String_map.map vars ~f:Rules.of_meta_rules; preds = [toolchain] }
let get { vars; preds } var =
Vars.get vars var preds
end
type package =
{ name : string
; dir : Path.t

6
src/findlib.mli
View File

@ -82,3 +82,9 @@ val all_packages : t -> package list
val all_unavailable_packages : t -> Package_not_available.t list
val stdlib_with_archives : t -> package
module Config : sig
type t
val load : Path.t -> toolchain:string -> context:string -> t
val get : t -> string -> string
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)

71
src/install.ml
View File

@ -47,6 +47,35 @@ module Section = struct
; "man" , Man
; "misc" , Misc
]
module Paths = struct
let lib = Path.(relative root) "lib"
let libexec = Path.(relative root) "lib"
let bin = Path.(relative root) "bin"
let sbin = Path.(relative root) "sbin"
let toplevel = Path.(relative root) "lib/toplevel"
let share = Path.(relative root) "share"
let share_root = Path.(relative root) "share_root"
let etc = Path.(relative root) "etc"
let doc = Path.(relative root) "doc"
let stublibs = Path.(relative root) "lib/stublibs"
let man = Path.(relative root) "man"
end
let install_dir t ~package =
match t with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
| Toplevel -> Paths.toplevel
| Share_root -> Paths.share_root
| Stublibs -> Paths.stublibs
| Man -> Paths.man
| Lib -> Path.relative Paths.lib package
| Libexec -> Path.relative Paths.libexec package
| Share -> Path.relative Paths.share package
| Etc -> Path.relative Paths.etc package
| Doc -> Path.relative Paths.doc package
| Misc -> invalid_arg "Install.Section.install_dir"
end
module Entry = struct
@ -82,36 +111,8 @@ module Entry = struct
let set_src t src = { t with src }
module Paths = struct
let lib = Path.(relative root) "lib"
let libexec = Path.(relative root) "lib"
let bin = Path.(relative root) "bin"
let sbin = Path.(relative root) "sbin"
let toplevel = Path.(relative root) "lib/toplevel"
let share = Path.(relative root) "share"
let share_root = Path.(relative root) "share_root"
let etc = Path.(relative root) "etc"
let doc = Path.(relative root) "doc"
let stublibs = Path.(relative root) "lib/stublibs"
let man = Path.(relative root) "man"
end
let relative_installed_path t ~package =
let main_dir =
match t.section with
| Bin -> Paths.bin
| Sbin -> Paths.sbin
| Toplevel -> Paths.toplevel
| Share_root -> Paths.share_root
| Stublibs -> Paths.stublibs
| Man -> Paths.man
| Lib -> Path.relative Paths.lib package
| Libexec -> Path.relative Paths.libexec package
| Share -> Path.relative Paths.share package
| Etc -> Path.relative Paths.etc package
| Doc -> Path.relative Paths.doc package
| Misc -> invalid_arg "Install.Entry.relative_installed_path"
in
let main_dir = Section.install_dir t.section ~package in
let dst =
match t.dst with
| Some x -> x
@ -126,6 +127,18 @@ module Entry = struct
| _ -> dst
in
Path.relative main_dir dst
let add_install_prefix t ~package ~prefix =
let opam_will_install_in_this_dir =
Section.install_dir t.section ~package
in
let i_want_to_install_the_file_as =
Path.append prefix (relative_installed_path t ~package)
in
let dst =
Path.reach i_want_to_install_the_file_as ~from:opam_will_install_in_this_dir
in
{ t with dst = Some dst }
end
module SMap = Map.Make(Section)

1
src/install.mli
View File

@ -29,6 +29,7 @@ module Entry : sig
val set_src : t -> Path.t -> t
val relative_installed_path : t -> package:string -> Path.t
val add_install_prefix : t -> package:string -> prefix:Path.t -> t
end
val files : Entry.t list -> Path.Set.t

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

38
src/main.ml
View File

@ -12,7 +12,8 @@ type setup =
let package_install_file { packages; _ } pkg =
match String_map.find pkg packages with
| None -> Error ()
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
| Some p ->
Ok (Path.relative p.path (Utils.install_file ~package:p.name ~findlib_toolchain:None))
let setup ?(log=Log.no_log) ?unlink_aliases
?filter_out_optional_stanzas_with_missing_deps
@ -20,6 +21,7 @@ let setup ?(log=Log.no_log) ?unlink_aliases
?(use_findlib=true)
?only_packages
?extra_ignored_subtrees
?x
() =
let conf = Jbuild_load.load ?extra_ignored_subtrees () in
Option.iter only_packages ~f:(fun set ->
@ -33,26 +35,34 @@ let setup ?(log=Log.no_log) ?unlink_aliases
| Some w -> w
| None ->
if Sys.file_exists workspace_file then
Workspace.load workspace_file
Workspace.load ?x workspace_file
else
{ merlin_context = Some "default"; contexts = [Default] }
{ merlin_context = Some "default"
; contexts = [Default [
match x with
| None -> Native
| Some x -> Named x
]]
}
in
Future.all
(List.map workspace.contexts ~f:(function
| Workspace.Context.Default ->
Context.default ~merlin:(workspace.merlin_context = Some "default")
~use_findlib ()
| Opam { name; switch; root; merlin } ->
Context.create_for_opam ~name ~switch ?root ~merlin ()))
Future.all (
List.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)
)
>>= fun contexts ->
List.iter contexts ~f:(fun ctx ->
let contexts = List.concat contexts in
List.iter contexts ~f:(fun (ctx : Context.t) ->
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx));
Gen_rules.gen conf ~contexts
Gen_rules.gen conf
~contexts
?unlink_aliases
?only_packages
?filter_out_optional_stanzas_with_missing_deps
>>= fun (rules, stanzas) ->
let build_system = Build_system.create ~contexts ~file_tree:conf.file_tree ~rules in
let build_system = Build_system.create ~contexts
~file_tree:conf.file_tree ~rules in
return { build_system
; stanzas
; contexts
@ -211,7 +221,7 @@ let bootstrap () =
Clflags.debug_dep_path := true;
let log = Log.create () in
Future.Scheduler.go ~log
(setup ~log ~workspace:{ merlin_context = Some "default"; contexts = [Default] }
(setup ~log ~workspace:{ merlin_context = Some "default"; contexts = [Default [Native]] }
~use_findlib:false
~extra_ignored_subtrees:ignored_during_bootstrap
()

1
src/main.mli
View File

@ -22,6 +22,7 @@ val setup
-> ?workspace:Workspace.t
-> ?workspace_file:string
-> ?only_packages:String_set.t
-> ?x:string
-> unit
-> setup Future.t
val external_lib_deps

14
src/path.ml
View File

@ -381,7 +381,9 @@ let drop_build_context t =
let exists t = Sys.file_exists (to_string t)
let readdir t = Sys.readdir (to_string t) |> Array.to_list
let is_directory t = Sys.is_directory (to_string t)
let is_directory t =
try Sys.is_directory (to_string t)
with Sys_error _ -> false
let rmdir t = Unix.rmdir (to_string t)
let unlink t = Unix.unlink (to_string t)
let unlink_no_err t = try Unix.unlink (to_string t) with _ -> ()
@ -429,3 +431,13 @@ let change_extension ~ext t =
let extension = Filename.extension
let pp = Format.pp_print_string
let drop_prefix t ~prefix =
let t = to_string t in
let prefix =
to_string (
if String.is_suffix prefix ~suffix:"/" then
prefix
else
prefix ^ "/") in
String.drop_prefix t ~prefix

8
src/path.mli
View File

@ -114,4 +114,12 @@ val change_extension : ext:string -> t -> t
val extension : t -> string
(** maintains the invariant:
{[
let suffix = Option.value_exn (Path.drop_prefix t ~prefix) in
Path.relative prefix suffix = t
]}
*)
val drop_prefix : t -> prefix:t -> string option
val pp : t Fmt.t

41
src/sexp.ml
View File

@ -343,20 +343,35 @@ module Of_sexp = struct
let ( @> ) a b = Constructor_args_spec.Cons (a, b)
module Constructor_spec = struct
type ('a, 'b, 'c) unpacked =
type ('a, 'b, 'c) tuple =
{ name : string
; args : ('a, 'b) Constructor_args_spec.t
; rest : ('b, 'c) rest
; make : Loc.t -> 'a
}
type 'a t = T : (_, _, 'a) unpacked -> 'a t
type 'a record =
{ name : string
; parse : 'a record_parser
}
type 'a t =
| Tuple : (_, _, 'a) tuple -> 'a t
| Record : 'a record -> 'a t
let name = function
| Tuple x -> x.name
| Record x -> x.name
end
module C = Constructor_spec
let cstr_loc name args make =
Constructor_spec.T { name; args; make; rest = No_rest }
C.Tuple { name; args; make; rest = No_rest }
let cstr_rest_loc name args rest make =
Constructor_spec.T { name; args; make; rest = Many rest }
C.Tuple { name; args; make; rest = Many rest }
let cstr_record name parse =
C.Record { name; parse }
let cstr name args make =
cstr_loc name args (fun _ -> make)
@ -368,8 +383,8 @@ module Of_sexp = struct
let find_cstr cstrs sexp name =
match
List.find cstrs ~f:(fun (Constructor_spec.T cstr) ->
equal_cstr_name cstr.name name)
List.find cstrs ~f:(fun cstr ->
equal_cstr_name (C.name cstr) name)
with
| Some cstr -> cstr
| None ->
@ -377,22 +392,24 @@ module Of_sexp = struct
"Unknown constructor %s%s" name
(hint
(String.uncapitalize_ascii name)
(List.map cstrs ~f:(fun (Constructor_spec.T c) ->
String.uncapitalize_ascii c.name)))
(List.map cstrs ~f:(fun c ->
String.uncapitalize_ascii (C.name c))))
let sum cstrs sexp =
match sexp with
| Atom (loc, s) -> begin
let (Constructor_spec.T c) = find_cstr cstrs sexp s in
Constructor_args_spec.convert c.args c.rest sexp [] (c.make loc)
match find_cstr cstrs sexp s with
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
| C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
end
| List (_, []) -> of_sexp_error sexp "non-empty list expected"
| List (loc, name_sexp :: args) ->
match name_sexp with
| List _ -> of_sexp_error name_sexp "Atom expected"
| Atom (_, s) ->
let (Constructor_spec.T c) = find_cstr cstrs sexp s in
Constructor_args_spec.convert c.args c.rest sexp args (c.make loc)
match find_cstr cstrs sexp s with
| C.Tuple t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc)
| C.Record r -> record r.parse (List (loc, args))
let enum cstrs sexp =
match sexp with

2
src/sexp.mli
View File

@ -85,6 +85,8 @@ module Of_sexp : sig
-> 'a
-> 'c Constructor_spec.t
val cstr_record : string -> 'a record_parser -> 'a Constructor_spec.t
val cstr_loc
: string
-> ('a, 'b) Constructor_args_spec.t

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

5
src/utils.ml
View File

@ -133,6 +133,11 @@ let obj_name_of_basename fn =
| None -> fn
| Some i -> String.sub fn ~pos:0 ~len:i
let install_file ~package ~findlib_toolchain =
match findlib_toolchain with
| None -> package ^ ".install"
| Some x -> sprintf "%s-%s.install" package x
module Cached_digest = struct
type file =
{ mutable digest : Digest.t

2
src/utils.mli
View File

@ -43,6 +43,8 @@ val find_deps : dir:Path.t -> 'a String_map.t -> string -> 'a
*)
val obj_name_of_basename : string -> string
val install_file : package:string -> findlib_toolchain:string option -> string
(** Digest files with caching *)
module Cached_digest : sig
(** Digest the contents of the following file *)

98
src/workspace.ml
View File

@ -2,36 +2,69 @@ open Import
open Sexp.Of_sexp
module Context = struct
module Target = struct
type t =
| Native
| Named of string
let t sexp =
match string sexp with
| "native" -> Native
| s -> Named s
end
module Opam = struct
type t =
{ name : string
; switch : string
; root : string option
; merlin : bool
{ name : string
; switch : string
; root : string option
; merlin : bool
; targets : Target.t list
}
let t =
record
(field "switch" string >>= fun switch ->
field "name" string ~default:switch >>= fun name ->
field_o "root" string >>= fun root ->
field_b "merlin" >>= fun merlin ->
return { switch
; name
; root
; merlin
})
field "switch" string >>= fun switch ->
field "name" string ~default:switch >>= fun name ->
field "targets" (list Target.t) ~default:[Target.Native] >>= fun targets ->
field_o "root" string >>= fun root ->
field_b "merlin" >>= fun merlin ->
return { switch
; name
; root
; merlin
; targets
}
end
type t = Default | Opam of Opam.t
type t = Default of Target.t list | Opam of Opam.t
let t = function
| Atom (_, "default") -> Default
| sexp -> Opam (Opam.t sexp)
| Atom (_, "default") -> Default [Native]
| List (_, List _ :: _) as sexp -> Opam (record Opam.t sexp)
| sexp ->
sum
[ cstr_record "default"
(field "targets" (list Target.t) ~default:[Target.Native]
>>= fun targets ->
return (Default targets))
; cstr_record "opam"
(Opam.t >>= fun x -> return (Opam x))
]
sexp
let name = function
| Default -> "default"
| Opam o -> o.name
| Default _ -> "default"
| Opam o -> o.name
let targets = function
| Default l -> l
| Opam o -> o.targets
let all_names t =
let n = name t in
n :: List.filter_map (targets t) ~f:(function
| Native -> None
| Named s -> Some (n ^ "." ^ s))
end
type t =
@ -39,7 +72,8 @@ type t =
; contexts : Context.t list
}
let t sexps =
let t ?x sexps =
let defined_names = ref String_set.empty in
let merlin_ctx, contexts =
List.fold_left sexps ~init:(None, []) ~f:(fun (merlin_ctx, ctxs) sexp ->
let ctx =
@ -47,6 +81,21 @@ let t sexps =
[ cstr "context" (Context.t @> nil) (fun x -> x) ]
sexp
in
let ctx =
match x with
| None -> ctx
| Some s ->
let target = Context.Target.Named s in
let add_target target targets =
if List.mem target ~set:targets then
targets
else
targets @ [target]
in
match ctx with
| Default targets -> Default (add_target target targets)
| Opam o -> Opam { o with targets = add_target target o.targets }
in
let name = Context.name ctx in
if name = "" ||
String.is_prefix name ~prefix:"." ||
@ -55,8 +104,9 @@ let t sexps =
String.contains name '/' ||
String.contains name '\\' then
of_sexp_errorf sexp "%S is not allowed as a build context name" name;
if List.exists ctxs ~f:(fun c -> Context.name c = name) then
if String_set.mem name !defined_names then
of_sexp_errorf sexp "second definition of build context %S" name;
defined_names := String_set.union !defined_names (String_set.of_list (Context.all_names ctx));
match ctx, merlin_ctx with
| Opam { merlin = true; _ }, Some _ ->
of_sexp_errorf sexp "you can only have one context for merlin"
@ -67,14 +117,14 @@ let t sexps =
in
let contexts =
match contexts with
| [] -> [Context.Default]
| [] -> [Context.Default [Native]]
| _ -> contexts
in
let merlin_ctx =
match merlin_ctx with
| Some _ -> merlin_ctx
| None ->
if List.mem Context.Default ~set:contexts then
if List.exists contexts ~f:(function Context.Default _ -> true | _ -> false) then
Some "default"
else
None
@ -83,4 +133,4 @@ let t sexps =
; contexts = List.rev contexts
}
let load fname = t (Sexp.load ~fname ~mode:Many)
let load ?x fname = t ?x (Sexp.load ~fname ~mode:Many)

12
src/workspace.mli
View File

@ -3,16 +3,24 @@
open! Import
module Context : sig
module Target : sig
type t =
| Native
| Named of string
end
module Opam : sig
type t =
{ name : string
; switch : string
; root : string option
; merlin : bool
; targets : Target.t list
}
end
type t = Default | Opam of Opam.t
type t = Default of Target.t list | Opam of Opam.t
val name : t -> string
end
type t =
@ -20,4 +28,4 @@ type t =
; contexts : Context.t list
}
val load : string -> t
val load : ?x:string -> string -> t

7
test/blackbox-tests/jbuild
View File

@ -162,3 +162,10 @@
(action
(chdir test-cases/c-stubs
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))
(alias
((name runtest)
(deps ((files_recursively_in test-cases/cross-compilation)))
(action
(chdir test-cases/cross-compilation
(setenv JBUILDER ${bin:jbuilder} (run ${exe:cram.exe} run.t))))))

1
test/blackbox-tests/test-cases/cross-compilation/bin/blah.ml Normal file
View File

@ -0,0 +1 @@
let () = Printf.printf "%d\n" P.x

6
test/blackbox-tests/test-cases/cross-compilation/bin/jbuild Normal file
View File

@ -0,0 +1,6 @@
(jbuild_version 1)
(executable
((name blah)
(public_name blah)
(libraries (p))))

0
test/blackbox-tests/test-cases/cross-compilation/etc/findlib.conf Normal file
View File

0
test/blackbox-tests/test-cases/cross-compilation/etc/findlib.conf.d/foo.conf Normal file
View File

3
test/blackbox-tests/test-cases/cross-compilation/jbuild Normal file
View File

@ -0,0 +1,3 @@
(jbuild_version 1)
(rule (with-stdout-to file (run ./bin/blah.exe)))

5
test/blackbox-tests/test-cases/cross-compilation/lib/jbuild Normal file
View File

@ -0,0 +1,5 @@
(jbuild_version 1)
(library
((name p)
(public_name p)))

1
test/blackbox-tests/test-cases/cross-compilation/lib/p.ml Normal file
View File

@ -0,0 +1 @@
let x = 42

0
test/blackbox-tests/test-cases/cross-compilation/p.opam Normal file
View File

41
test/blackbox-tests/test-cases/cross-compilation/run.t Normal file
View File

@ -0,0 +1,41 @@
$ env OCAMLFIND_CONF=$PWD/etc/findlib.conf $JBUILDER build --root . -j1 -x foo file @install
ocamldep bin/blah.depends.ocamldep-output [default.foo]
ocamldep lib/p.depends.ocamldep-output [default.foo]
ocamldep bin/blah.depends.ocamldep-output
ocamlc lib/p.{cmi,cmo,cmt} [default.foo]
ocamldep lib/p.depends.ocamldep-output
ocamlopt lib/p.{cmx,o} [default.foo]
ocamlc bin/blah.{cmi,cmo,cmt} [default.foo]
ocamlc lib/p.cma [default.foo]
ocamlc lib/p.{cmi,cmo,cmt}
ocamlopt lib/p.{a,cmxa} [default.foo]
ocamlopt bin/blah.{cmx,o} [default.foo]
ocamlc bin/blah.{cmi,cmo,cmt}
ocamlopt lib/p.{cmx,o}
ocamlopt lib/p.cmxs [default.foo]
ocamlopt bin/blah.exe [default.foo]
ocamlopt bin/blah.{cmx,o}
ocamlopt lib/p.{a,cmxa}
ocamlopt bin/blah.exe
blah file [default.foo]
blah file
$ cat _build/default.foo/file
42
$ ls *.install
p-foo.install
$ cat p-foo.install
lib: [
"_build/install/default.foo/lib/p/META" {"../../foo-sysroot/lib/p/META"}
"_build/install/default.foo/lib/p/opam" {"../../foo-sysroot/lib/p/opam"}
"_build/install/default.foo/lib/p/p.cmi" {"../../foo-sysroot/lib/p/p.cmi"}
"_build/install/default.foo/lib/p/p.cmx" {"../../foo-sysroot/lib/p/p.cmx"}
"_build/install/default.foo/lib/p/p.cmt" {"../../foo-sysroot/lib/p/p.cmt"}
"_build/install/default.foo/lib/p/p.ml" {"../../foo-sysroot/lib/p/p.ml"}
"_build/install/default.foo/lib/p/p.cma" {"../../foo-sysroot/lib/p/p.cma"}
"_build/install/default.foo/lib/p/p.cmxa" {"../../foo-sysroot/lib/p/p.cmxa"}
"_build/install/default.foo/lib/p/p.a" {"../../foo-sysroot/lib/p/p.a"}
"_build/install/default.foo/lib/p/p.cmxs" {"../../foo-sysroot/lib/p/p.cmxs"}
]
bin: [
"_build/install/default.foo/bin/blah" {"../foo-sysroot/bin/blah"}
]