Don't force to have a default context

bin/main.ml

@@ -153,7 +153,7 @@ let resolve_targets (setup : Main.setup) user_targets =
             [File path]
           else
             match
-              List.filter_map setup.all_contexts ~f:(fun ctx ->
+              List.filter_map setup.contexts ~f:(fun ctx ->
                 let path = Path.append ctx.Context.build_dir path in
                 if Build_system.is_target setup.build_system path then
                   Some (File path)
@@ -251,12 +251,12 @@ let install_uninstall ~what =
               (List.map missing_install_files ~f:(sprintf "- %s")))
            (String.concat ~sep:" " (List.map pkgs ~f:(sprintf "%s.install")))
        end;
-       (match setup.all_contexts, prefix with
+       (match setup.contexts, prefix with
         | _ :: _ :: _, Some _ ->
           die "Cannot specify --prefix when installing into multiple contexts!"
         | _ -> ());
        Future.all_unit
-         (List.map setup.all_contexts ~f:(fun context ->
+         (List.map setup.contexts ~f:(fun context ->
             get_prefix context ~from_command_line:prefix >>= fun prefix ->
             Future.all_unit
               (List.map install_files ~f:(fun path ->

src/main.ml

@@ -4,8 +4,7 @@ open Future
 type setup =
   { build_system : Build_system.t
   ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
-  ; context      : Context.t
-  ; all_contexts : Context.t list
+  ; contexts     : Context.t list
   ; packages     : Package.t String_map.t
   }
 
@@ -14,20 +13,23 @@ let package_install_file { packages; _ } pkg =
   | None -> Error ()
   | Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
 
-let setup ?filter_out_optional_stanzas_with_missing_deps () =
+let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () =
   let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
-  (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 ()))
-   else
-     return [])
+  let workspace =
+    match workspace with
+    | Some w -> w
+    | None ->
+      if Sys.file_exists "jbuild-workspace" then
+        Workspace.load "jbuild-workspace"
+      else
+        [Default]
+  in
+  Future.all
+    (List.map workspace ~f:(function
+     | Workspace.Context.Default -> Lazy.force Context.default
+     | Opam { name; switch; root } ->
+       Context.create_for_opam ~name ~switch ?root ()))
   >>= fun contexts ->
-  (match List.find contexts ~f:(fun c -> c.name = "default") with
-   | None -> Lazy.force Context.default
-   | Some c -> return c)
-  >>= fun default_context ->
   let rules =
     Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
       ?filter_out_optional_stanzas_with_missing_deps ()
@@ -35,8 +37,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps () =
   let build_system = Build_system.create ~file_tree ~rules in
   return { build_system
          ; stanzas
-         ; context = default_context
-         ; all_contexts = contexts
+         ; contexts
          ; packages
          }
 
@@ -117,7 +118,7 @@ let bootstrap () =
       ]
       anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
     Future.Scheduler.go ~log:(create_log ())
-      (setup () >>= fun { build_system = bs; _ } ->
+      (setup ~workspace:[Default] () >>= fun { build_system = bs; _ } ->
        Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
   in
   try

src/main.mli

@@ -1,11 +1,10 @@
 open! Import
 
 type setup =
-  { build_system   : Build_system.t
-  ; stanzas        : (Path.t * Jbuild_types.Stanza.t list) list
-  ; context        : Context.t
-  ; all_contexts   : Context.t list
-  ; packages       : Package.t String_map.t
+  { build_system : Build_system.t
+  ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
+  ; contexts     : Context.t list
+  ; packages     : Package.t String_map.t
   }
 
 (* Returns [Error ()] if [pkg] is unknown *)
@@ -13,6 +12,7 @@ val package_install_file : setup -> string -> (Path.t, unit) result
 
 val setup
   :  ?filter_out_optional_stanzas_with_missing_deps:bool
+  -> ?workspace:Workspace.t
   -> unit
   -> setup Future.t
 val external_lib_deps

src/workspace.ml

@@ -6,21 +6,33 @@ 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
-    }
+  module Opam = 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
-              })
+    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 = Default | Opam of Opam.t
+
+  let t = function
+    | Atom "default" -> Default
+    | sexp -> Opam (Opam.t sexp)
+
+  let name = function
+    | Default -> "default"
+    | Opam o  -> o.name
 end
 
 type t = Context.t list
@@ -32,13 +44,14 @@ let t sexps =
         [ cstr "context" [Context.t] (fun x -> x) ]
         sexp
     in
-    begin match ctx.name with
-    | ".aliases" | "log" as s ->
-      of_sexp_errorf sexp "%S is not allowed as a build context name" s
+    let name = Context.name ctx in
+    begin match name with
+    | ".aliases" | "log" ->
+      of_sexp_errorf sexp "%S is not allowed as a build context name" name
     | _ -> ()
     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;
+    if List.exists acc ~f:(fun c -> Context.name c = name) then
+      of_sexp_errorf sexp "second definition of build context %S" name;
     ctx :: acc)
   |> List.rev