diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 80a1adfe..cda85b5c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -1778,23 +1778,33 @@ module Gen(P : Params) = struct end) end -let gen ~contexts ~file_tree ~tree ~stanzas ~packages - ?(filter_out_optional_stanzas_with_missing_deps=true) () = +let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf = + let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in let alias_store = Alias.Store.create () in let rules = List.concat_map contexts ~f:(fun context -> - let module M = - Gen(struct - let context = context - let file_tree = file_tree - let stanzas = stanzas - let packages = packages - let filter_out_optional_stanzas_with_missing_deps = - filter_out_optional_stanzas_with_missing_deps - let alias_store = alias_store - end) - in - !M.all_rules) + let stanzas = + List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path + ; version + ; sexps + ; visible_packages + } -> + (path, + List.filter_map sexps ~f:(Stanza.select version) + |> Stanza.resolve_packages ~dir:path ~visible_packages)) + in + let module M = + Gen(struct + let context = context + let file_tree = file_tree + let stanzas = stanzas + let packages = packages + let filter_out_optional_stanzas_with_missing_deps = + filter_out_optional_stanzas_with_missing_deps + let alias_store = alias_store + end) + in + !M.all_rules) in Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree @ rules diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 815583dc..55b4d7fa 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -1,11 +1,7 @@ -open Import +open! Import val gen : contexts:Context.t list - -> file_tree:File_tree.t - -> tree:Alias.tree - -> stanzas:(Path.t * Jbuild_types.Stanza.t list) list - -> packages:Package.t String_map.t -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *) - -> unit + -> Jbuild_load.conf -> Build_interpret.Rule.t list diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index e5fd6db4..8ba7df12 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -1,10 +1,19 @@ open Import open Jbuild_types +module Jbuild = struct + type t = + { path : Path.t + ; version : Jbuild_types.Jbuilder_version.t + ; sexps : Sexp.Ast.t list + ; visible_packages : Package.t String_map.t + } +end + type conf = { file_tree : File_tree.t ; tree : Alias.tree - ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list + ; jbuilds : Jbuild.t list ; packages : Package.t String_map.t } @@ -23,11 +32,12 @@ let load ~dir ~visible_packages ~version = | _ :: (_, loc) :: _ -> Loc.fail loc "jbuilder_version specified too many times" in - let stanzas = - List.filter_map sexps ~f:(Stanza.select version) - |> Stanza.resolve_packages ~dir ~visible_packages - in - (version, stanzas) + { Jbuild. + path = dir + ; version + ; sexps + ; visible_packages + } let load () = let ftree = File_tree.load Path.root in @@ -67,7 +77,7 @@ let load () = |> List.map ~f:(fun pkg -> (pkg.Package.path, pkg)) |> Path.Map.of_alist_multi in - let rec walk dir stanzas visible_packages version = + let rec walk dir jbuilds visible_packages version = let path = File_tree.Dir.path dir in let files = File_tree.Dir.files dir in let sub_dirs = File_tree.Dir.sub_dirs dir in @@ -78,12 +88,12 @@ let load () = List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg -> String_map.add acc ~key:pkg.Package.name ~data:pkg) in - let version, stanzas = + let version, jbuilds = if String_set.mem "jbuild" files then - let version, stanzas_here = load ~dir:path ~visible_packages ~version in - (version, (path, stanzas_here) :: stanzas) + let jbuild = load ~dir:path ~visible_packages ~version in + (jbuild.version, jbuild :: jbuilds) else - (version, stanzas) + (version, jbuilds) in let sub_dirs = if String_set.mem "jbuild-ignore" files then @@ -96,18 +106,18 @@ let load () = else sub_dirs in - let children, stanzas = - String_map.fold sub_dirs ~init:([], stanzas) - ~f:(fun ~key:_ ~data:dir (children, stanzas) -> - let child, stanzas = walk dir stanzas visible_packages version in - (child :: children, stanzas)) + let children, jbuilds = + String_map.fold sub_dirs ~init:([], jbuilds) + ~f:(fun ~key:_ ~data:dir (children, jbuilds) -> + let child, jbuilds = walk dir jbuilds visible_packages version in + (child :: children, jbuilds)) in - (Alias.Node (path, children), stanzas) + (Alias.Node (path, children), jbuilds) in let root = File_tree.root ftree in - let tree, stanzas = walk root [] String_map.empty Jbuilder_version.latest_stable in + let tree, jbuilds = walk root [] String_map.empty Jbuilder_version.latest_stable in { file_tree = ftree ; tree - ; stanzas + ; jbuilds ; packages } diff --git a/src/jbuild_load.mli b/src/jbuild_load.mli index f1d9f99d..558f4dfd 100644 --- a/src/jbuild_load.mli +++ b/src/jbuild_load.mli @@ -1,9 +1,18 @@ open Import +module Jbuild : sig + type t = + { path : Path.t + ; version : Jbuild_types.Jbuilder_version.t + ; sexps : Sexp.Ast.t list + ; visible_packages : Package.t String_map.t + } +end + type conf = { file_tree : File_tree.t ; tree : Alias.tree - ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list + ; jbuilds : Jbuild.t list ; packages : Package.t String_map.t } diff --git a/src/main.ml b/src/main.ml index 7fffc671..602f505d 100644 --- a/src/main.ml +++ b/src/main.ml @@ -3,7 +3,7 @@ open Future type setup = { build_system : Build_system.t - ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list + ; jbuilds : Jbuild_load.Jbuild.t list ; contexts : Context.t list ; packages : Package.t String_map.t } @@ -14,7 +14,7 @@ let package_install_file { packages; _ } pkg = | Some p -> Ok (Path.relative p.path (p.name ^ ".install")) let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () = - let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in + let conf = Jbuild_load.load () in let workspace = match workspace with | Some w -> w @@ -31,20 +31,20 @@ let setup ?filter_out_optional_stanzas_with_missing_deps ?workspace () = Context.create_for_opam ~name ~switch ?root ())) >>= fun contexts -> let rules = - Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages - ?filter_out_optional_stanzas_with_missing_deps () + Gen_rules.gen conf ~contexts + ?filter_out_optional_stanzas_with_missing_deps in - let build_system = Build_system.create ~file_tree ~rules in + let build_system = Build_system.create ~file_tree:conf.file_tree ~rules in return { build_system - ; stanzas + ; jbuilds = conf.jbuilds ; contexts - ; packages + ; packages = conf.packages } let external_lib_deps ?log ~packages () = Future.Scheduler.go ?log (setup () ~filter_out_optional_stanzas_with_missing_deps:false - >>| fun ({ build_system = bs; stanzas; _ } as setup) -> + >>| fun ({ build_system = bs; jbuilds; _ } as setup) -> let install_files = List.map packages ~f:(fun pkg -> match package_install_file setup pkg with @@ -54,6 +54,15 @@ let external_lib_deps ?log ~packages () = Path.Map.map (Build_system.all_lib_deps bs install_files) ~f:(fun deps -> + let stanzas = + List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path + ; version + ; sexps + ; _ + } -> + (path, + List.filter_map sexps ~f:(Jbuild_types.Stanza.select version))) + in let internals = Jbuild_types.Stanza.lib_names stanzas in String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals)))) diff --git a/src/main.mli b/src/main.mli index 7bea65b1..3642ce35 100644 --- a/src/main.mli +++ b/src/main.mli @@ -2,7 +2,7 @@ open! Import type setup = { build_system : Build_system.t - ; stanzas : (Path.t * Jbuild_types.Stanza.t list) list + ; jbuilds : Jbuild_load.Jbuild.t list ; contexts : Context.t list ; packages : Package.t String_map.t }