Move actual parsing of jbuilds to Gen_rules

src/gen_rules.ml

@@ -1778,23 +1778,33 @@ module Gen(P : Params) = struct
       end)
 end
 
-let gen ~contexts ~file_tree ~tree ~stanzas ~packages
+let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf =
-    ?(filter_out_optional_stanzas_with_missing_deps=true) () =
+  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 =
+      let stanzas =
-          Gen(struct
+        List.map jbuilds ~f:(fun { Jbuild_load.Jbuild. path
-            let context  = context
+                                 ; version
-            let file_tree = file_tree
+                                 ; sexps
-            let stanzas  = stanzas
+                                 ; visible_packages
-            let packages = packages
+                                 } ->
-            let filter_out_optional_stanzas_with_missing_deps =
+          (path,
-              filter_out_optional_stanzas_with_missing_deps
+           List.filter_map sexps ~f:(Stanza.select version)
-            let alias_store = alias_store
+           |> Stanza.resolve_packages ~dir:path ~visible_packages))
-          end)
+      in
-        in
+      let module M =
-        !M.all_rules)
+        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

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

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 =
+  { Jbuild.
-    List.filter_map sexps ~f:(Stanza.select version)
+    path = dir
-    |> Stanza.resolve_packages ~dir ~visible_packages
+  ; version
-  in
+  ; sexps
-  (version, stanzas)
+  ; 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
+        let jbuild = load ~dir:path ~visible_packages ~version in
-        (version, (path, stanzas_here) :: stanzas)
+        (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 =
+    let children, jbuilds =
-      String_map.fold sub_dirs ~init:([], stanzas)
+      String_map.fold sub_dirs ~init:([], jbuilds)
-        ~f:(fun ~key:_ ~data:dir (children, stanzas) ->
+        ~f:(fun ~key:_ ~data:dir (children, jbuilds) ->
-          let child, stanzas = walk dir stanzas visible_packages version in
+          let child, jbuilds = walk dir jbuilds visible_packages version in
-          (child :: children, stanzas))
+          (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
   }

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
   }
 

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
+    Gen_rules.gen conf ~contexts
-      ?filter_out_optional_stanzas_with_missing_deps ()
+      ?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))))
 

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
   }