Initial support for build contexts

src/context.ml

@@ -78,17 +78,12 @@ let opam_config_var ~env ~cache var =
       Hashtbl.add cache ~key:var ~data: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
   (match kind with
    | Opam { root; _ } ->
      Hashtbl.add opam_var_cache ~key:"root" ~data:root
    | Default -> ());
-  let name =
-    match kind with
-    | Default -> "default"
-    | Opam { switch; _ } -> switch
-  in
   let prog_not_found_in_path prog =
     die "Program %s not found in PATH (context: %s)" prog name
   in
@@ -110,10 +105,7 @@ let create ~(kind : Kind.t) ~path ~env =
     | Some fn -> fn
   in
   let build_dir =
-    match kind with
-    | Default -> Path.of_string "_build/default"
-    | Opam { root = _; switch } ->
-      Path.of_string (sprintf "_build/%s" switch)
+    Path.of_string (sprintf "_build/%s" name)
   in
   let ocamlc_config_cmd = sprintf "%s -config" (Path.to_string ocamlc) in
   both
@@ -246,7 +238,7 @@ let default = lazy (
       | _ -> find_path (i + 1)
   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 imported =
@@ -263,7 +255,7 @@ let extend_env ~vars ~env =
     imported
   |> Array.of_list
 
-let create_for_opam ?root ~switch () =
+let create_for_opam ?root ~switch ~name () =
   match Bin.opam with
   | None -> die "Program opam not found in PATH"
   | Some fn ->
@@ -287,6 +279,7 @@ let create_for_opam ?root ~switch () =
     in
     let env = Lazy.force initial_env in
     create ~kind:(Opam { root; switch }) ~path ~env:(extend_env ~vars ~env)
+      ~name
 
 let which t s = Bin.which ~path:t.path s
 

src/context.mli

@@ -92,7 +92,12 @@ type t =
   ; 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
 

src/main.ml

@@ -16,9 +16,20 @@ let package_install_file { packages; _ } pkg =
 let setup ?filter_out_optional_stanzas_with_missing_deps () =
   let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
   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 =
-    Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
-      ?filter_out_optional_stanzas_with_missing_deps ()
+    List.concat_map all_contexts ~f:(fun context ->
+      Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
+        ?filter_out_optional_stanzas_with_missing_deps ())
   in
   let build_system = Build_system.create ~file_tree ~rules in
   return { build_system

src/main.mli

@@ -1,10 +1,10 @@
 open! Import
 
 type setup =
-  { build_system : Build_system.t
-  ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
-  ; context      : Context.t
-  ; packages     : Package.t String_map.t
+  { build_system   : Build_system.t
+  ; stanzas        : (Path.t * Jbuild_types.Stanza.t list) list
+  ; context        : Context.t
+  ; packages       : Package.t String_map.t
   }
 
 (* Returns [Error ()] if [pkg] is unknown *)

src/workspace.ml

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