Initial support for build contexts
This commit is contained in:
parent
a603fb658f
commit
677b9e1e06
|
@ -78,17 +78,12 @@ let opam_config_var ~env ~cache var =
|
||||||
Hashtbl.add cache ~key:var ~data:s;
|
Hashtbl.add cache ~key:var ~data:s;
|
||||||
Some s
|
Some s
|
||||||
|
|
||||||
let create ~(kind : Kind.t) ~path ~env =
|
let create ~(kind : Kind.t) ~path ~env ~name =
|
||||||
let opam_var_cache = Hashtbl.create 128 in
|
let opam_var_cache = Hashtbl.create 128 in
|
||||||
(match kind with
|
(match kind with
|
||||||
| Opam { root; _ } ->
|
| Opam { root; _ } ->
|
||||||
Hashtbl.add opam_var_cache ~key:"root" ~data:root
|
Hashtbl.add opam_var_cache ~key:"root" ~data:root
|
||||||
| Default -> ());
|
| Default -> ());
|
||||||
let name =
|
|
||||||
match kind with
|
|
||||||
| Default -> "default"
|
|
||||||
| Opam { switch; _ } -> switch
|
|
||||||
in
|
|
||||||
let prog_not_found_in_path prog =
|
let prog_not_found_in_path prog =
|
||||||
die "Program %s not found in PATH (context: %s)" prog name
|
die "Program %s not found in PATH (context: %s)" prog name
|
||||||
in
|
in
|
||||||
|
@ -110,10 +105,7 @@ let create ~(kind : Kind.t) ~path ~env =
|
||||||
| Some fn -> fn
|
| Some fn -> fn
|
||||||
in
|
in
|
||||||
let build_dir =
|
let build_dir =
|
||||||
match kind with
|
Path.of_string (sprintf "_build/%s" name)
|
||||||
| Default -> Path.of_string "_build/default"
|
|
||||||
| Opam { root = _; switch } ->
|
|
||||||
Path.of_string (sprintf "_build/%s" switch)
|
|
||||||
in
|
in
|
||||||
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
|
let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
|
||||||
both
|
both
|
||||||
|
@ -246,7 +238,7 @@ let default = lazy (
|
||||||
| _ -> find_path (i + 1)
|
| _ -> find_path (i + 1)
|
||||||
in
|
in
|
||||||
let path = find_path 0 in
|
let path = find_path 0 in
|
||||||
create ~kind:Default ~path ~env)
|
create ~kind:Default ~path ~env ~name:"default")
|
||||||
|
|
||||||
let extend_env ~vars ~env =
|
let extend_env ~vars ~env =
|
||||||
let imported =
|
let imported =
|
||||||
|
@ -263,7 +255,7 @@ let extend_env ~vars ~env =
|
||||||
imported
|
imported
|
||||||
|> Array.of_list
|
|> Array.of_list
|
||||||
|
|
||||||
let create_for_opam ?root ~switch () =
|
let create_for_opam ?root ~switch ~name () =
|
||||||
match Bin.opam with
|
match Bin.opam with
|
||||||
| None -> die "Program opam not found in PATH"
|
| None -> die "Program opam not found in PATH"
|
||||||
| Some fn ->
|
| Some fn ->
|
||||||
|
@ -287,6 +279,7 @@ let create_for_opam ?root ~switch () =
|
||||||
in
|
in
|
||||||
let env = Lazy.force initial_env in
|
let env = Lazy.force initial_env in
|
||||||
create ~kind:(Opam { root; switch }) ~path ~env:(extend_env ~vars ~env)
|
create ~kind:(Opam { root; switch }) ~path ~env:(extend_env ~vars ~env)
|
||||||
|
~name
|
||||||
|
|
||||||
let which t s = Bin.which ~path:t.path s
|
let which t s = Bin.which ~path:t.path s
|
||||||
|
|
||||||
|
|
|
@ -92,7 +92,12 @@ type t =
|
||||||
; cmt_magic_number : string
|
; cmt_magic_number : string
|
||||||
}
|
}
|
||||||
|
|
||||||
val create_for_opam : ?root:string -> switch:string -> unit -> t Future.t
|
val create_for_opam
|
||||||
|
: ?root:string
|
||||||
|
-> switch:string
|
||||||
|
-> name:string
|
||||||
|
-> unit
|
||||||
|
-> t Future.t
|
||||||
|
|
||||||
val default : t Future.t Lazy.t
|
val default : t Future.t Lazy.t
|
||||||
|
|
||||||
|
|
15
src/main.ml
15
src/main.ml
|
@ -16,9 +16,20 @@ let package_install_file { packages; _ } pkg =
|
||||||
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
||||||
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
|
||||||
Lazy.force Context.default >>= fun context ->
|
Lazy.force Context.default >>= fun context ->
|
||||||
|
(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 ()))
|
||||||
|
>>= fun other_contexts ->
|
||||||
|
return (context :: other_contexts)
|
||||||
|
else
|
||||||
|
return [context])
|
||||||
|
>>= fun all_contexts ->
|
||||||
let rules =
|
let rules =
|
||||||
Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
|
List.concat_map all_contexts ~f:(fun context ->
|
||||||
?filter_out_optional_stanzas_with_missing_deps ()
|
Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||||
|
?filter_out_optional_stanzas_with_missing_deps ())
|
||||||
in
|
in
|
||||||
let build_system = Build_system.create ~file_tree ~rules in
|
let build_system = Build_system.create ~file_tree ~rules in
|
||||||
return { build_system
|
return { build_system
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
open! Import
|
open! Import
|
||||||
|
|
||||||
type setup =
|
type setup =
|
||||||
{ build_system : Build_system.t
|
{ build_system : Build_system.t
|
||||||
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
; stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||||
; context : Context.t
|
; context : Context.t
|
||||||
; packages : Package.t String_map.t
|
; packages : Package.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
||||||
(* Returns [Error ()] if [pkg] is unknown *)
|
(* Returns [Error ()] if [pkg] is unknown *)
|
||||||
|
|
|
@ -0,0 +1,45 @@
|
||||||
|
open Import
|
||||||
|
open Sexp.Of_sexp
|
||||||
|
|
||||||
|
type sexp = Sexp.t = Atom of string | List of sexp list
|
||||||
|
let of_sexp_error = Sexp.of_sexp_error
|
||||||
|
let of_sexp_errorf = Sexp.of_sexp_errorf
|
||||||
|
|
||||||
|
module Context = struct
|
||||||
|
type t =
|
||||||
|
{ name : string
|
||||||
|
; switch : string
|
||||||
|
; root : string option
|
||||||
|
}
|
||||||
|
|
||||||
|
let t =
|
||||||
|
record
|
||||||
|
(field "switch" string >>= fun switch ->
|
||||||
|
field "name" string ~default:switch >>= fun name ->
|
||||||
|
field_o "root" string >>= fun root ->
|
||||||
|
return { switch
|
||||||
|
; name
|
||||||
|
; root
|
||||||
|
})
|
||||||
|
end
|
||||||
|
|
||||||
|
type t = Context.t list
|
||||||
|
|
||||||
|
let t sexps =
|
||||||
|
List.fold_left sexps ~init:[] ~f:(fun acc sexp ->
|
||||||
|
let ctx =
|
||||||
|
sum
|
||||||
|
[ cstr "context" [Context.t] (fun x -> x) ]
|
||||||
|
sexp
|
||||||
|
in
|
||||||
|
begin match ctx.name with
|
||||||
|
| "default" | ".aliases" | "log" as s ->
|
||||||
|
of_sexp_errorf sexp "%S is not allowed as a build context name" s
|
||||||
|
| _ -> ()
|
||||||
|
end;
|
||||||
|
if List.exists acc ~f:(fun c -> c.Context.name = ctx.name) then
|
||||||
|
of_sexp_errorf sexp "second definition of build context %S" ctx.name;
|
||||||
|
ctx :: acc)
|
||||||
|
|> List.rev
|
||||||
|
|
||||||
|
let load fn = Sexp_load.many fn t
|
Loading…
Reference in New Issue