Interpret jbuild-ignore files sooner

Interpret then while loading the file tree.

src/build_system.ml

@@ -603,14 +603,14 @@ let dump_trace t = Trace.dump t.trace
 
 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
-      Cont
-        (Pset.union acc
-           (File_tree.Dir.files dir
-            |> String_set.elements
-            |> List.map ~f:(Path.relative path)
-            |> Pset.of_list)))
+    File_tree.fold file_tree ~init:Pset.empty ~traverse_ignored_dirs:true
+      ~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))
   in
   let all_copy_targets =
     List.fold_left contexts ~init:Pset.empty ~f:(fun acc (ctx : Context.t) ->

src/file_tree.ml

@@ -1,31 +1,25 @@
 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
     ; files    : String_set.t
     ; sub_dirs : t String_map.t
+    ; ignored  : bool
     }
 
   let path t = t.path
   let files t = t.files
   let sub_dirs t = t.sub_dirs
+  let ignored t = t.ignored
 
-  let rec fold t ~init ~f =
-    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)
+  let rec fold t ~traverse_ignored_dirs ~init:acc ~f =
+    if not traverse_ignored_dirs && t.ignored then
+      acc
+    else
+      let acc = f t acc in
+      String_map.fold t.sub_dirs ~init:acc ~f:(fun ~key:_ ~data:t acc ->
+        fold t ~traverse_ignored_dirs ~init:acc ~f)
 end
 
 type t =
@@ -41,37 +35,54 @@ let ignore_file fn ~is_directory =
   (fn.[0] = '.' && fn.[1] = '#')
 
 let load path =
-  let rec walk path : Dir.t =
+  let rec walk path ~ignored : Dir.t =
     let files, sub_dirs =
       Path.readdir path
       |> List.filter_map ~f:(fun fn ->
         let path = Path.relative path fn in
-        let is_directory = Path.exists path && Path.is_directory path in
+        let is_directory =
+          try Path.is_directory path with _ -> false
+        in
         if ignore_file fn ~is_directory then
           None
+        else if is_directory then
+          Some (Inr (fn, path))
         else
-          Some (fn, path, is_directory))
-      |> List.partition_map ~f:(fun (fn, path, is_directory)  ->
-          if is_directory then
-            Inr (fn, walk path)
-          else
-            Inl fn)
+          Some (Inl fn))
+      |> List.partition_map ~f:(fun x -> x)
+    in
+    let files = String_set.of_list files in
+    let ignored_sub_dirs =
+      if not ignored && String_set.mem "jbuild-ignore" files then
+        String_set.of_list
+          (Io.lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
+      else
+        String_set.empty
+    in
+    let sub_dirs =
+      List.map sub_dirs ~f:(fun (fn, path) ->
+        let ignored = ignored || String_set.mem fn ignored_sub_dirs in
+        (fn, walk path ~ignored))
+      |> String_map.of_alist_exn
     in
     { path
-    ; files    = String_set.of_list files
-    ; sub_dirs = String_map.of_alist_exn sub_dirs
+    ; files
+    ; sub_dirs
+    ; ignored
     }
   in
-  let root = walk path in
+  let root = walk path ~ignored:false in
   let dirs =
-    Dir.fold root ~init:Path.Map.empty ~f:(fun dir acc ->
-      Cont (Path.Map.add acc ~key:dir.path ~data:dir))
+    Dir.fold root ~init:Path.Map.empty ~traverse_ignored_dirs:true
+      ~f:(fun dir acc ->
+        Path.Map.add acc ~key:dir.path ~data:dir)
   in
   { root
   ; dirs
   }
 
-let fold t ~init ~f = Dir.fold t.root ~init ~f
+let fold t ~traverse_ignored_dirs ~init ~f =
+  Dir.fold t.root ~traverse_ignored_dirs ~init ~f
 
 let find_dir t path =
   Path.Map.find path t.dirs
@@ -89,8 +100,8 @@ let files_recursively_in t ?(prefix_with=Path.root) path =
   match find_dir t path with
   | None -> Path.Set.empty
   | Some dir ->
-    Dir.fold dir ~init:Path.Set.empty ~f:(fun dir acc ->
-      let path = Path.append prefix_with (Dir.path dir) in
-      Cont
-        (String_set.fold (Dir.files dir) ~init:acc ~f:(fun fn acc ->
-           Path.Set.add (Path.relative path fn) acc)))
+    Dir.fold dir ~init:Path.Set.empty ~traverse_ignored_dirs:true
+      ~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))

src/file_tree.mli

@@ -1,23 +1,27 @@
 open! Import
 
-
 module Dir : sig
   type t
 
   val path     : t -> Path.t
   val files    : t -> String_set.t
   val sub_dirs : t -> t String_map.t
+
+  (** Whether this directory is ignored by a [jbuild-ignore] file in
+      one of its ancestor directories. *)
+  val ignored : t -> bool
 end
 
 type t
 
 val load : Path.t -> t
 
-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 fold
+  :  t
+  -> traverse_ignored_dirs:bool
+  -> init:'a
+  -> f:(Dir.t -> 'a -> 'a)
+  -> 'a
 
 val root : t -> Dir.t
 

src/jbuild_load.ml

@@ -166,39 +166,25 @@ let load ~dir ~scope =
 
 let load ?(extra_ignored_subtrees=Path.Set.empty) () =
   let ftree = File_tree.load Path.root in
-  let packages, ignored_subtrees =
-    File_tree.fold ftree ~init:([], extra_ignored_subtrees) ~f:(fun dir (pkgs, ignored) ->
+  let packages =
+    File_tree.fold ftree ~traverse_ignored_dirs:false ~init:[] ~f:(fun dir pkgs ->
       let path = File_tree.Dir.path dir in
       let files = File_tree.Dir.files dir in
-      let pkgs =
-        String_set.fold files ~init:pkgs ~f:(fun fn acc ->
-          match Filename.split_extension fn with
-          | (pkg, ".opam") when pkg <> "" ->
-            let version_from_opam_file =
-              let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
-              match Opam_file.get_field opam "version" with
-              | Some (String (_, s)) -> Some s
-              | _ -> None
-            in
-            (pkg,
-             { Package. name = pkg
-             ; path
-             ; version_from_opam_file
-             }) :: acc
-          | _ -> acc)
-      in
-      if String_set.mem "jbuild-ignore" files then
-        let ignore_set =
-          String_set.of_list
-            (Io.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))
+      String_set.fold files ~init:pkgs ~f:(fun fn acc ->
+        match Filename.split_extension fn with
+        | (pkg, ".opam") when pkg <> "" ->
+          let version_from_opam_file =
+            let opam = Opam_file.load (Path.relative path fn |> Path.to_string) in
+            match Opam_file.get_field opam "version" with
+            | Some (String (_, s)) -> Some s
+            | _ -> None
+          in
+          (pkg,
+           { Package. name = pkg
+           ; path
+           ; version_from_opam_file
+           }) :: acc
+        | _ -> acc))
   in
   let packages =
     String_map.of_alist_multi packages
@@ -219,30 +205,36 @@ let load ?(extra_ignored_subtrees=Path.Set.empty) () =
     |> Path.Map.map ~f:Scope.make
   in
   let rec walk dir jbuilds scope =
-    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
-    let scope = Path.Map.find_default path scopes ~default:scope in
-    let jbuilds =
-      if String_set.mem "jbuild" files then
-        let jbuild = load ~dir:path ~scope in
-        jbuild :: jbuilds
-      else
-        jbuilds
-    in
-    let children, jbuilds =
-      String_map.fold sub_dirs ~init:([], jbuilds)
-        ~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
-          if Path.Set.mem (File_tree.Dir.path dir) ignored_subtrees then
-            (children, jbuilds)
-          else
-            let child, jbuilds = walk dir jbuilds scope in
-            (child :: children, jbuilds))
-    in
-    (Alias.Node (path, children), jbuilds)
+    if File_tree.Dir.ignored dir ||
+       Path.Set.mem (File_tree.Dir.path dir) extra_ignored_subtrees then
+      None
+    else begin
+      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
+      let scope = Path.Map.find_default path scopes ~default:scope in
+      let jbuilds =
+        if String_set.mem "jbuild" files then
+          let jbuild = load ~dir:path ~scope in
+          jbuild :: jbuilds
+        else
+          jbuilds
+      in
+      let children, jbuilds =
+        String_map.fold sub_dirs ~init:([], jbuilds)
+          ~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
+            match walk dir jbuilds scope with
+            | None -> (children, jbuilds)
+            | Some (child, jbuilds) -> (child :: children, jbuilds))
+      in
+      Some (Alias.Node (path, children), jbuilds)
+    end
   in
   let root = File_tree.root ftree in
-  let tree, jbuilds = walk root [] Scope.empty in
+  let tree, jbuilds =
+    Option.value (walk root [] Scope.empty)
+      ~default:(Alias.Node (File_tree.Dir.path root, []), [])
+  in
   { file_tree = ftree
   ; tree
   ; jbuilds