Cleanups

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>

src/dune_file.ml

@@ -787,6 +787,34 @@ module Mode_conf = struct
   end
 end
 
+module External_variant = struct
+  type t =
+    { implementation : Lib_name.t
+    ; virtual_lib : Lib_name.t
+    ; variant : Variant.t
+    ; project : Dune_project.t
+    ; loc : Loc.t
+    }
+
+  let decode =
+    let open Stanza.Decoder in
+    record (
+      let+ loc = loc
+      and+ variant = field "variant" Variant.decode
+      and+ virtual_lib = field "virtual_library" Lib_name.decode
+      and+ implementation = field "implementation" Lib_name.decode
+      and+ project = Dune_project.get_exn ()
+      in
+      { implementation
+      ; virtual_lib
+      ; variant
+      ; project
+      ; loc
+      }
+    )
+end
+
+
 module Library = struct
   module Inherited = struct
     type 'a t =
@@ -1127,6 +1155,23 @@ module Library = struct
       match stdlib.exit_module with
       | None -> false
       | Some n -> n = name
+
+  let external_variant (t : t) =
+    match t with
+    | { variant = Some variant
+      ; implements = Some (loc, virtual_lib)
+      ; project
+      ; _
+      } ->
+      Some
+        { External_variant.
+          implementation = best_name t
+        ; virtual_lib
+        ; variant
+        ; project
+        ; loc
+        }
+    | _ -> None
 end
 
 module Install_conf = struct
@@ -2085,33 +2130,6 @@ module Toplevel = struct
     )
 end
 
-module External_variant = struct
-  type t =
-    { implementation : Lib_name.t
-    ; virtual_lib : Lib_name.t
-    ; variant : Variant.t
-    ; project : Dune_project.t
-    ; loc : Loc.t
-    }
-
-  let decode =
-    let open Stanza.Decoder in
-    record (
-      let+ loc = loc
-      and+ variant = field "variant" Variant.decode
-      and+ virtual_lib = field "virtual_library" Lib_name.decode
-      and+ implementation = field "implementation" Lib_name.decode
-      and+ project = Dune_project.get_exn ()
-      in
-      { implementation
-      ; virtual_lib
-      ; variant
-      ; project
-      ; loc
-      }
-    )
-end
-
 module Copy_files = struct
   type t = { add_line_directive : bool
            ; glob : String_with_vars.t
@@ -2354,3 +2372,7 @@ let stanza_package = function
   | Coq.T { public = Some { package; _ }; _ } ->
     Some package
   | _ -> None
+
+let lib = function
+  | Library l -> Some l
+  | _ -> None

src/dune_file.mli

@@ -170,6 +170,16 @@ module Mode_conf : sig
   end
 end
 
+module External_variant : sig
+  type t =
+    { implementation : Lib_name.t
+    ; virtual_lib : Lib_name.t
+    ; variant : Variant.t
+    ; project : Dune_project.t
+    ; loc : Loc.t
+    }
+end
+
 module Library : sig
   module Inherited : sig
     type 'a t =
@@ -260,6 +270,8 @@ module Library : sig
       to change the compilation unit name of such modules, so they
       cannot be wrapped. *)
   val special_compiler_module : t -> Module.t -> bool
+
+  val external_variant : t -> External_variant.t option
 end
 
 module Install_conf : sig
@@ -450,16 +462,6 @@ module Toplevel : sig
     }
 end
 
-module External_variant : sig
-  type t =
-    { implementation : Lib_name.t
-    ; virtual_lib : Lib_name.t
-    ; variant : Variant.t
-    ; project : Dune_project.t
-    ; loc : Loc.t
-    }
-end
-
 module Include_subdirs : sig
   type qualification = Unqualified | Qualified
   type t = No | Include of qualification
@@ -476,7 +478,10 @@ type Stanza.t +=
   | Tests                  of Tests.t
   | Include_subdirs        of Loc.t * Include_subdirs.t
   | Toplevel               of Toplevel.t
-  | External_variant of External_variant.t
+  | External_variant       of External_variant.t
+
+
+val lib : Stanza.t -> Library.t option
 
 val stanza_package : Stanza.t -> Package.t option
 

src/gen_rules.ml

@@ -295,42 +295,28 @@ module type Gen = sig
   val sctx : Super_context.t
 end
 
-let turn_library_into_external_variant visible_libraries lib =
-  match lib with
-  | { Library.variant=(Some variant)
-    ; implements=(Some (loc, vlib))
-    ; project
-    ; _} as conf ->
-    Option.some_if
-      (Lib_name.Set.mem visible_libraries vlib)
-      (External_variant
-         { implementation = (Library.best_name conf)
-         ; virtual_lib = vlib
-         ; variant
-         ; project
-         ; loc
-         })
-  | _ -> None
-
-let map_stanza visible_libraries = function
-  | Library lib -> turn_library_into_external_variant visible_libraries lib
-  | _ -> None
-
-let filter_out_stanzas_from_hidden_packages visible_libraries pkgs stanzas =
-  List.filter_map stanzas ~f:(fun stanza ->
+let filter_out_stanzas_from_hidden_packages ~visible_libs ~visible_pkgs =
+  List.filter_map ~f:(fun stanza ->
     match Dune_file.stanza_package stanza with
-    | Some package when Package.Name.Set.mem pkgs package.name -> Some stanza
     | None -> Some stanza
-    | Some _ -> map_stanza visible_libraries stanza
-  )
+    | Some package when Package.Name.Set.mem visible_pkgs package.name ->
+      Some stanza
+    | Some _ ->
+      let open Option.O in
+      let* lib = Dune_file.lib stanza in
+      let* (external_variant : External_variant.t) =
+        Library.external_variant lib in
+      Option.some_if
+        (Lib_name.Set.mem visible_libs external_variant.virtual_lib)
+        (External_variant external_variant))
 
-let visible_libraries pkgs =
+let visible_libs ~visible_pkgs =
   Dune_load.Dune_file.fold_stanzas
     ~init:Lib_name.Set.empty
     ~f:(fun _ s set -> match s with
       | Library ({ public = Some { package; _ }; _} as conf)
-          when (Package.Name.Set.mem pkgs package.name) ->
-            Lib_name.Set.add set (Library.best_name conf)
+        when (Package.Name.Set.mem visible_pkgs package.name) ->
+        Lib_name.Set.add set (Library.best_name conf)
       | _ -> set)
 
 let gen ~contexts
@@ -361,11 +347,12 @@ let gen ~contexts
       let+ stanzas = Dune_load.Dune_files.eval ~context dune_files in
       match only_packages with
       | None -> stanzas
-      | Some pkgs ->
-        let visible_libraries = visible_libraries pkgs stanzas in
+      | Some visible_pkgs ->
+        let visible_libs = visible_libs ~visible_pkgs stanzas in
         List.map stanzas ~f:(fun (dir_conf : Dune_load.Dune_file.t) ->
           { dir_conf with
-            stanzas = filter_out_stanzas_from_hidden_packages visible_libraries pkgs dir_conf.stanzas
+            stanzas = filter_out_stanzas_from_hidden_packages
+                        ~visible_libs ~visible_pkgs dir_conf.stanzas
           })
     in
     let* (host, stanzas) = Fiber.fork_and_join host stanzas in
@@ -388,7 +375,8 @@ let gen ~contexts
   let+ contexts = Fiber.parallel_map contexts ~f:make_sctx in
   let map = String.Map.of_list_exn contexts in
   let sctxs = String.Map.map map ~f:(fun (module M : Gen) -> M.sctx) in
-  let generators = (String.Map.map map ~f:(fun (module M : Gen) -> M.gen_rules)) in
+  let generators =
+    String.Map.map map ~f:(fun (module M : Gen) -> M.gen_rules) in
   let () =
     Build_system.set_packages (fun path ->
       let open Option.O in

src/lib.ml

@@ -781,9 +781,8 @@ let find_implementation_for lib ~variants =
         ~init:[]
         ~f:(fun variant acc ->
           match Variant.Map.find available_implementations variant with
-          | Some res -> res::acc
-          | None -> acc
-        )
+          | Some res -> res :: acc
+          | None -> acc)
       |> Result.List.all
     in
     match candidates with
@@ -825,9 +824,7 @@ let rec instantiate db name (info : Lib_info.t) ~stack ~hidden =
     Option.map info.default_implementation ~f:(fun l -> lazy (resolve l)) in
   let resolved_implementations =
     Option.map info.virtual_ ~f:(fun _ -> lazy (
-      Variant.Map.map info.known_implementations
-        ~f:(fun ((loc : Loc.t), (name : Lib_name.t)) -> resolve (loc, name))
-    ))
+      Variant.Map.map info.known_implementations ~f:resolve))
   in
   let requires, pps, resolved_selects =
     resolve_user_deps db info.requires ~allow_private_deps ~pps:info.pps ~stack
@@ -1322,13 +1319,12 @@ module DB = struct
 
   let extract_loc_from_variant_map vmap =
     Variant.Map.choose vmap
-    |> Option.map
-         ~f:(fun (_, (loc, _)) -> loc)
+    |> Option.map ~f:(fun (_, (loc, _)) -> loc)
 
   let check_valid_external_variants
         (libmap : resolve_result Lib_name.Map.t)
         (variant_map : (Loc.t * Lib_name.t) Variant.Map.t Lib_name.Map.t) =
-    let do_the_check vlib variants =
+    Lib_name.Map.iteri variant_map ~f:(fun vlib variants ->
       let loc = extract_loc_from_variant_map variants in
       match Lib_name.Map.find libmap vlib with
       | None ->
@@ -1343,22 +1339,21 @@ module DB = struct
         Errors.fail_opt loc
           "To declare variants you must use %a's public name,@ which is %a."
           Lib_name.pp vlib Lib_name.pp best_name
-      | _ -> ()
-    in
-    Lib_name.Map.iteri variant_map ~f:do_the_check
+      | _ -> ())
 
   let create_from_library_stanzas ?parent ~lib_config lib_stanzas
         variants_stanzas =
     (* Lookup the local scope to find implementations*)
     let project_implementations =
-      let extract_variant = function
-        | _, ({ Dune_file.Library.implements=Some (loc, vlib)
-              ; variant=Some variant
-              ; _} as conf) -> Some (vlib, (variant, (loc, Dune_file.Library.best_name conf)))
+      let extract_variant (_, lib) =
+        match lib with
+        | { Dune_file.Library.implements = Some (loc, vlib)
+          ; variant = Some variant
+          ; _ } -> Some (vlib,
+                         (variant, (loc, Dune_file.Library.best_name lib)))
         | _ -> None
       in
-      lib_stanzas
-      |> List.filter_map ~f:extract_variant
+      List.filter_map ~f:extract_variant lib_stanzas
     in
     let variant_map =
       variants_stanzas
@@ -1368,7 +1363,7 @@ module DB = struct
       |> List.rev_append project_implementations
       |> Lib_name.Map.of_list_multi
       |> Lib_name.Map.map ~f:Variant.Map.of_list
-      |> Lib_name.Map.mapi ~f:(fun name x -> match x with
+      |> Lib_name.Map.mapi ~f:(fun name -> function
         | Ok x -> x
         | Error (variant, (loc1, impl1), (loc2, impl2)) ->
           Errors.fail_opt None
@@ -1380,13 +1375,13 @@ module DB = struct
             Lib_name.pp impl1
             Loc.pp_file_colon_line loc1
             Lib_name.pp impl2
-            Loc.pp_file_colon_line loc2
-      )
+            Loc.pp_file_colon_line loc2)
     in
     let map =
       List.concat_map lib_stanzas ~f:(fun (dir, (conf : Dune_file.Library.t)) ->
         let variants =
-          Lib_name.Map.find variant_map (Dune_file.Library.best_name conf)
+          Dune_file.Library.best_name conf
+          |> Lib_name.Map.find variant_map
           |> Option.value ~default:Variant.Map.empty
         in
         let info = Lib_info.of_library_stanza ~dir ~lib_config variants conf in
@@ -1695,7 +1690,8 @@ let () =
       Some (Report_error.make_printer ?loc ?hint pp)
     | _ -> None)
 
-let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir=
+let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects
+      ~dir =
   let add_loc = List.map ~f:(fun x -> (info.loc, x.name)) in
   let virtual_ = Option.is_some info.virtual_ in
   let obj_dir = Obj_dir.convert_to_external ~dir (obj_dir lib) in
@@ -1709,7 +1705,8 @@ let to_dune_lib ({ name ; info ; _ } as lib) ~lib_modules ~foreign_objects ~dir=
       | None ->
         match Path.drop_build_context info.src_dir with
         | None -> info.src_dir
-        | Some src_dir -> Path.(of_string (to_absolute_filename (Path.source src_dir)))
+        | Some src_dir ->
+          Path.(of_string (to_absolute_filename (Path.source src_dir)))
     )
     else None
   in

src/scope.ml

@@ -119,8 +119,9 @@ module DB = struct
       |> Dune_project.Name.Map.of_list_multi
     in
     let variant_implementations_by_project_name =
-      List.map variant_implementations ~f:(fun (lib : Dune_file.External_variant.t) ->
-        (Dune_project.name lib.project, lib))
+      List.map variant_implementations
+        ~f:(fun (lib : Dune_file.External_variant.t) ->
+          (Dune_project.name lib.project, lib))
       |> Dune_project.Name.Map.of_list_multi
     in
     let libs_variants_by_project_name =
@@ -135,10 +136,9 @@ module DB = struct
     Dune_project.Name.Map.merge projects_by_name libs_variants_by_project_name
       ~f:(fun _name project l_v ->
         let project = Option.value_exn project in
-        let libs, variants = Option.value l_v ~default:([],[]) in
+        let libs, variants = Option.value l_v ~default:([], []) in
         let db = Lib.DB.create_from_library_stanzas libs variants
-                   ~parent:public_libs
-                   ~lib_config in
+                   ~parent:public_libs ~lib_config in
         let root =
           Path.Build.append_source build_context_dir
             (Dune_project.root project) in