diff --git a/src/context.ml b/src/context.ml index 96f53812..f375333d 100644 --- a/src/context.ml +++ b/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 diff --git a/src/context.mli b/src/context.mli index cc39c54b..0dea1d34 100644 --- a/src/context.mli +++ b/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 diff --git a/src/main.ml b/src/main.ml index b91cf074..cdfb4771 100644 --- a/src/main.ml +++ b/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 diff --git a/src/main.mli b/src/main.mli index c7494f1d..a1aa5cba 100644 --- a/src/main.mli +++ b/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 *) diff --git a/src/workspace.ml b/src/workspace.ml new file mode 100644 index 00000000..2bf117af --- /dev/null +++ b/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