diff --git a/src/build_system.ml b/src/build_system.ml index adcd49c4..1c04b15e 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -473,12 +473,13 @@ end let create ~contexts ~file_tree ~rules = let all_source_files = File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc -> - let path = File_tree.Dir.path dir in - Pset.union acc - (File_tree.Dir.files dir - |> String_set.elements - |> List.map ~f:(Path.relative path) - |> Pset.of_list)) + let path = File_tree.Dir.path dir in + Cont + (Pset.union acc + (File_tree.Dir.files dir + |> String_set.elements + |> List.map ~f:(Path.relative path) + |> Pset.of_list))) in let all_copy_targets = List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) -> diff --git a/src/file_tree.ml b/src/file_tree.ml index 296da89f..a9ef5a14 100644 --- a/src/file_tree.ml +++ b/src/file_tree.ml @@ -1,5 +1,9 @@ open! Import +type 'a fold_callback_result = + | Cont of 'a + | Dont_recurse_in of String_set.t * 'a + module Dir = struct type t = { path : Path.t @@ -12,9 +16,16 @@ module Dir = struct let sub_dirs t = t.sub_dirs let rec fold t ~init ~f = - let init = f t init in - String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc -> + match f t init with + | Cont init -> + String_map.fold t.sub_dirs ~init ~f:(fun ~key:_ ~data:t acc -> fold t ~init:acc ~f) + | Dont_recurse_in (forbidden, init) -> + String_map.fold t.sub_dirs ~init ~f:(fun ~key:sub_dir ~data:t acc -> + if String_set.mem sub_dir forbidden then + acc + else + fold t ~init:acc ~f) end type t = @@ -54,14 +65,13 @@ let load path = let root = walk path in let dirs = Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc -> - Path.Map.add acc ~key:dir.path ~data:dir) + Cont (Path.Map.add acc ~key:dir.path ~data:dir)) in { root ; dirs } -let fold t ~init ~f = - Path.Map.fold t.dirs ~init ~f:(fun ~key:_ ~data:dir acc -> f dir acc) +let fold t ~init ~f = Dir.fold t.root ~init ~f let find_dir t path = Path.Map.find path t.dirs @@ -81,5 +91,6 @@ let files_recursively_in t ?(prefix_with=Path.root) path = | Some dir -> Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc -> let path = Path.append prefix_with (Dir.path dir) in - String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc -> - Path.Set.add (Path.relative path fn) acc)) + Cont + (String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc -> + Path.Set.add (Path.relative path fn) acc))) diff --git a/src/file_tree.mli b/src/file_tree.mli index 586a94d1..ad41e6ea 100644 --- a/src/file_tree.mli +++ b/src/file_tree.mli @@ -13,7 +13,11 @@ type t val load : Path.t -> t -val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a) -> 'a +type 'a fold_callback_result = + | Cont of 'a + | Dont_recurse_in of String_set.t * 'a + +val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a fold_callback_result) -> 'a val root : t -> Dir.t diff --git a/src/jbuild_load.ml b/src/jbuild_load.ml index abe1bdb6..cc58b303 100644 --- a/src/jbuild_load.ml +++ b/src/jbuild_load.ml @@ -144,16 +144,18 @@ let load ~dir ~visible_packages ~closest_packages = let load () = let ftree = File_tree.load Path.root in - let packages = - File_tree.fold ftree ~init:[] ~f:(fun dir acc -> + let packages, ignored_subtrees = + File_tree.fold ftree ~init:([], Path.Set.empty) ~f:(fun dir (pkgs, ignored) -> let path = File_tree.Dir.path dir in - String_set.fold (File_tree.Dir.files dir) ~init:acc ~f:(fun fn acc -> - match Filename.split_ext fn with - | Some (pkg, ".opam") when pkg <> "" -> - let version_from_opam_file = - let lines = lines_of_file (Path.relative path fn |> Path.to_string) in - List.find_map lines ~f:(fun s -> - try + let files = File_tree.Dir.files dir in + let pkgs = + String_set.fold files ~init:pkgs ~f:(fun fn acc -> + match Filename.split_ext fn with + | Some (pkg, ".opam") when pkg <> "" -> + let version_from_opam_file = + let lines = lines_of_file (Path.relative path fn |> Path.to_string) in + List.find_map lines ~f:(fun s -> + try Scanf.sscanf s "version: %S" (fun x -> Some x) with _ -> None) @@ -163,8 +165,23 @@ let load () = ; path ; version_from_opam_file }) :: acc - | _ -> acc)) - |> String_map.of_alist_multi + | _ -> acc) + in + if String_set.mem "jbuild-ignore" files then + let ignore_set = + String_set.of_list + (lines_of_file (Path.to_string (Path.relative path "jbuild-ignore"))) + in + Dont_recurse_in + (ignore_set, + (pkgs, + String_set.fold ignore_set ~init:ignored ~f:(fun fn acc -> + Path.Set.add (Path.relative path fn) acc))) + else + Cont (pkgs, ignored)) + in + let packages = + String_map.of_alist_multi packages |> String_map.mapi ~f:(fun name pkgs -> match pkgs with | [pkg] -> pkg @@ -201,12 +218,8 @@ let load () = in let sub_dirs = if String_set.mem "jbuild-ignore" files then - let ignore_set = - String_set.of_list - (lines_of_file (Path.to_string (Path.relative path "jbuild-ignore"))) - in - String_map.filter sub_dirs ~f:(fun fn _ -> - not (String_set.mem fn ignore_set)) + String_map.filter sub_dirs ~f:(fun _ dir -> + not (Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees)) else sub_dirs in diff --git a/src/lib_db.ml b/src/lib_db.ml index 6a71e8c0..b765a57e 100644 --- a/src/lib_db.ml +++ b/src/lib_db.ml @@ -54,7 +54,9 @@ module Local_closure = Top_closure.Make(String)(struct let key ((_, lib) : t) = lib.name let deps ((dir, lib) : Lib.Internal.t) graph = List.concat_map lib.buildable.libraries ~f:(fun dep -> - List.filter_map (Lib_dep.to_lib_names dep) ~f:(find_internal ~from:dir graph)) + List.filter_map (Lib_dep.to_lib_names dep) ~f:(find_internal ~from:dir graph)) @ + List.filter_map lib.ppx_runtime_libraries ~f:(fun dep -> + find_internal ~from:dir graph dep) end) let top_sort_internals t ~internal_libraries = @@ -84,7 +86,9 @@ let compute_instalable_internal_libs t ~internal_libraries = List.fold_left (top_sort_internals t ~internal_libraries) ~init:t ~f:(fun t (dir, lib) -> if not lib.Library.optional || - List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t ~from:dir) then + (List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t ~from:dir) && + List.for_all lib.ppx_runtime_libraries ~f:(lib_is_installable t ~from:dir)) + then { t with instalable_internal_libs = String_map.add t.instalable_internal_libs