Add support for re_exports constructor

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

src/dune/dune_package.ml

@@ -14,10 +14,9 @@ module Lib = struct
     { info : Path.t Lib_info.t
     ; modules : Modules.t option
     ; main_module_name : Module_name.t option
-    ; requires : (Loc.t * Lib_name.t) list
     }
 
-  let make ~info ~main_module_name ~requires ~modules =
+  let make ~info ~main_module_name ~modules =
     let obj_dir = Lib_info.obj_dir info in
     let dir = Obj_dir.dir obj_dir in
     let map_path p =
@@ -27,13 +26,13 @@ module Lib = struct
         p
     in
     let info = Lib_info.map_path info ~f:map_path in
-    { info; main_module_name; requires; modules }
+    { info; main_module_name; modules }
 
   let dir_of_name name =
     let _, components = Lib_name.split name in
     Path.Local.L.relative Path.Local.root components
 
-  let encode ~package_root { info; requires; main_module_name; modules } =
+  let encode ~package_root { info; main_module_name; modules } =
     let open Dune_lang.Encoder in
     let no_loc f (_loc, x) = f x in
     let path = Dpath.Local.encode ~dir:package_root in
@@ -55,10 +54,10 @@ module Lib = struct
     let ppx_runtime_deps = Lib_info.ppx_runtime_deps info in
     let default_implementation = Lib_info.default_implementation info in
     let special_builtin_support = Lib_info.special_builtin_support info in
-    let re_exports = Lib_info.re_exports info in
     let archives = Lib_info.archives info in
     let sub_systems = Lib_info.sub_systems info in
     let plugins = Lib_info.plugins info in
+    let requires = Lib_info.requires info in
     let foreign_archives = Lib_info.foreign_archives info in
     let foreign_objects =
       match Lib_info.foreign_objects info with
@@ -78,7 +77,7 @@ module Lib = struct
        ; paths "foreign_objects" foreign_objects
        ; mode_paths "foreign_archives" foreign_archives
        ; paths "jsoo_runtime" jsoo_runtime
-       ; libs "requires" requires
+       ; Lib_info.Deps.field_encode requires ~name:"requires"
        ; libs "ppx_runtime_deps" ppx_runtime_deps
        ; field_o "implements" (no_loc Lib_name.encode) implements
        ; field_l "known_implementations"
@@ -93,7 +92,6 @@ module Lib = struct
        ; field_o "special_builtin_support"
            Dune_file.Library.Special_builtin_support.encode
            special_builtin_support
-       ; field_l "re_exports" (no_loc Lib_name.encode) re_exports
        ]
     @ ( Sub_system_name.Map.to_list sub_systems
       |> List.map ~f:(fun (name, info) ->
@@ -136,7 +134,7 @@ module Lib = struct
        and+ foreign_objects = paths "foreign_objects"
        and+ foreign_archives = mode_paths "foreign_archives"
        and+ jsoo_runtime = paths "jsoo_runtime"
-       and+ requires = libs "requires"
+       and+ requires = field_l "requires" Lib_dep.decode
        and+ ppx_runtime_deps = libs "ppx_runtime_deps"
        and+ virtual_ = field_b "virtual"
        and+ known_implementations =
@@ -154,10 +152,6 @@ module Lib = struct
          field_o "special_builtin_support"
            ( Dune_lang.Syntax.since Stanza.syntax (1, 10)
            >>> Dune_file.Library.Special_builtin_support.decode )
-       and+ re_exports =
-         field_l "re_exports"
-           ( Dune_lang.Syntax.since Stanza.syntax (2, 0)
-           >>> located Lib_name.decode )
        in
        let known_implementations =
          Variant.Map.of_list_exn known_implementations
@@ -172,7 +166,6 @@ module Lib = struct
            Dune_file.Library.Inherited.This main_module_name
          in
          let foreign_objects = Lib_info.Source.External foreign_objects in
-         let requires = Lib_info.Deps.Simple requires in
          let jsoo_archive = None in
          let pps = [] in
          let virtual_deps = [] in
@@ -189,15 +182,16 @@ module Lib = struct
            Option.map modules ~f:Modules.wrapped
            |> Option.map ~f:(fun w -> Dune_file.Library.Inherited.This w)
          in
+         let requires = Lib_info.Deps.Complex requires in
          Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir
            ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires
            ~foreign_objects ~plugins ~archives ~ppx_runtime_deps
            ~foreign_archives ~jsoo_runtime ~jsoo_archive ~pps ~enabled
            ~virtual_deps ~dune_version ~virtual_ ~implements ~variant
            ~known_implementations ~default_implementation ~modes ~wrapped
-           ~special_builtin_support ~re_exports
+           ~special_builtin_support
        in
-       { info; requires; main_module_name; modules })
+       { info; main_module_name; modules })
 
   let modules t = t.modules
 

src/dune/dune_package.mli

@@ -18,7 +18,6 @@ module Lib : sig
   val make :
        info:Path.t Lib_info.t
     -> main_module_name:Module_name.t option
-    -> requires:(Loc.t * Lib_name.t) list
     -> modules:Modules.t option
     -> t
 end

src/dune/findlib/findlib.ml

@@ -280,18 +280,14 @@ module Package = struct
       let known_implementations = P.Map.empty in
       let default_implementation = None in
       let wrapped = None in
-      let re_exports = [] in
       Lib_info.create ~loc ~name ~kind ~status ~src_dir ~orig_src_dir ~obj_dir
         ~version ~synopsis ~main_module_name ~sub_systems ~requires
         ~foreign_objects ~plugins ~archives ~ppx_runtime_deps ~foreign_archives
         ~jsoo_runtime ~jsoo_archive ~pps ~enabled ~virtual_deps ~dune_version
         ~virtual_ ~implements ~variant ~known_implementations
         ~default_implementation ~modes ~wrapped ~special_builtin_support
-        ~re_exports
     in
-    Dune_package.Lib.make ~info
-      ~requires:(List.map ~f:add_loc (requires t))
-      ~modules:None ~main_module_name:None
+    Dune_package.Lib.make ~info ~modules:None ~main_module_name:None
 
   (* XXX remove *)
 

src/dune/lib.ml

@@ -919,7 +919,10 @@ module rec Resolve : sig
     -> allow_private_deps:bool
     -> pps:(Loc.t * Lib_name.t) list
     -> stack:Dep_stack.t
-    -> lib list Or_exn.t * lib list Or_exn.t * Resolved_select.t list
+    -> lib list Or_exn.t
+       * lib list Or_exn.t
+       * Resolved_select.t list
+       * lib list Or_exn.t
 
   val closure_with_overlap_checks :
        db option
@@ -1003,7 +1006,7 @@ end = struct
                  Lib_info.known_implementations info
                |> Variant.Map.map ~f:resolve_impl ))
     in
-    let requires, pps, resolved_selects =
+    let requires, pps, resolved_selects, re_exports =
       let pps = Lib_info.pps info in
       Lib_info.requires info
       |> resolve_user_deps db ~allow_private_deps ~pps ~stack
@@ -1016,10 +1019,6 @@ end = struct
         let+ requires = requires in
         impl :: requires
     in
-    let re_exports : t list Or_exn.t =
-      Lib_info.re_exports info
-      |> resolve_simple_deps db ~allow_private_deps ~stack
-    in
     let ppx_runtime_deps =
       Lib_info.ppx_runtime_deps info
       |> resolve_simple_deps db ~allow_private_deps ~stack
@@ -1141,18 +1140,23 @@ end = struct
     List.rev !res
 
   let resolve_complex_deps db deps ~allow_private_deps ~stack =
-    let res, resolved_selects =
-      List.fold_left deps ~init:(Ok [], [])
-        ~f:(fun (acc_res, acc_selects) dep ->
-          let res, acc_selects =
+    let res, resolved_selects, re_exports =
+      List.fold_left deps ~init:(Ok [], [], Ok [])
+        ~f:(fun (acc_res, acc_selects, acc_re_exports) dep ->
+          let res, acc_selects, acc_re_exports =
             match (dep : Lib_dep.t) with
-            | Re_export _ -> assert false
+            | Re_export (loc, name) ->
+              let acc_re_exports =
+                resolve_dep db name ~allow_private_deps ~loc ~stack
+                >>| List.singleton
+              in
+              (acc_res, acc_selects, acc_re_exports)
             | Direct (loc, name) ->
               let res =
                 resolve_dep db name ~allow_private_deps ~loc ~stack
                 >>| List.singleton
               in
-              (res, acc_selects)
+              (res, acc_selects, acc_re_exports)
             | Select { result_fn; choices; loc } ->
               let res, src_fn =
                 match
@@ -1182,7 +1186,7 @@ end = struct
               in
               ( res
               , { Resolved_select.src_fn; dst_fn = result_fn } :: acc_selects
-              )
+              , acc_re_exports )
           in
           let res =
             match (res, acc_res) with
@@ -1191,29 +1195,20 @@ end = struct
              |_, (Error _ as res) ->
               res
           in
-          (res, acc_selects))
-    in
-    let res =
-      match res with
-      | Ok l -> Ok (List.rev l)
-      | Error _ -> res
+          (res, acc_selects, acc_re_exports))
     in
-    (res, resolved_selects)
+    let res = Result.map ~f:List.rev res in
+    let re_exports = Result.map ~f:List.rev re_exports in
+    (res, resolved_selects, re_exports)
 
   let resolve_deps db deps ~allow_private_deps ~stack =
-    (* Compute transitive closure *)
-    let libs, selects =
-      match (deps : Lib_info.Deps.t) with
-      | Simple names ->
-        (resolve_simple_deps db names ~allow_private_deps ~stack, [])
-      | Complex names ->
-        resolve_complex_deps db names ~allow_private_deps ~stack
-    in
-    (* Find implementations for virtual libraries. *)
-    (libs, selects)
+    match (deps : Lib_info.Deps.t) with
+    | Simple names ->
+      (resolve_simple_deps db names ~allow_private_deps ~stack, [], Ok [])
+    | Complex names -> resolve_complex_deps db names ~allow_private_deps ~stack
 
   let resolve_user_deps db deps ~allow_private_deps ~pps ~stack =
-    let deps, resolved_selects =
+    let deps, resolved_selects, re_exports =
       resolve_deps db deps ~allow_private_deps ~stack
     in
     let deps, pps =
@@ -1248,7 +1243,7 @@ end = struct
         (deps, pps)
     in
     let deps = deps >>= re_exports_closure in
-    (deps, pps, resolved_selects)
+    (deps, pps, resolved_selects, re_exports)
 
   (* Compute transitive closure of libraries to figure which ones will trigger
      their default implementation.
@@ -1751,7 +1746,7 @@ module DB = struct
           else
             Required )
     in
-    let res, pps, resolved_selects =
+    let res, pps, resolved_selects, _re_exports =
       Resolve.resolve_user_deps t
         (Lib_info.Deps.of_lib_deps deps)
         ~pps ~stack:Dep_stack.empty ~allow_private_deps:true
@@ -1899,9 +1894,12 @@ let to_dune_lib ({ info; _ } as lib) ~modules ~foreign_objects ~dir =
   let requires = add_loc requires in
   let+ re_exports = lib.re_exports in
   let re_exports = List.map ~f:(fun t -> (Loc.none, t.name)) re_exports in
-  let info = Lib_info.set_re_exports info re_exports in
-  Dune_package.Lib.make ~info ~requires ~modules:(Some modules)
-    ~main_module_name
+  let requires =
+    List.map ~f:Lib_dep.direct requires
+    @ List.map ~f:Lib_dep.re_export re_exports
+  in
+  let info = Lib_info.set_requires info (Complex requires) in
+  Dune_package.Lib.make ~info ~modules:(Some modules) ~main_module_name
 
 module Local : sig
   type t = private lib

src/dune/lib_dep.ml

@@ -10,9 +10,9 @@ module Select = struct
   let dyn_of_choice { required; forbidden; file } =
     let open Dyn.Encoder in
     record
-      [ "required", Lib_name.Set.to_dyn required
-      ; "forbidden", Lib_name.Set.to_dyn forbidden
-      ; "file", string file
+      [ ("required", Lib_name.Set.to_dyn required)
+      ; ("forbidden", Lib_name.Set.to_dyn forbidden)
+      ; ("file", string file)
       ]
 
   type t =
@@ -21,11 +21,11 @@ module Select = struct
     ; loc : Loc.t
     }
 
-  let to_dyn { result_fn ; choices ; loc = _ } =
+  let to_dyn { result_fn; choices; loc = _ } =
     let open Dyn.Encoder in
     record
-      [ "result_fn", string result_fn
-      ; "choices", list dyn_of_choice choices
+      [ ("result_fn", string result_fn)
+      ; ("choices", list dyn_of_choice choices)
       ]
 end
 
@@ -38,11 +38,13 @@ let to_dyn =
   let open Dyn.Encoder in
   function
   | Direct (_, name) -> Lib_name.to_dyn name
-  | Re_export (_, name) -> constr "re_export" [Lib_name.to_dyn name]
-  | Select s -> constr "select" [Select.to_dyn s]
+  | Re_export (_, name) -> constr "re_export" [ Lib_name.to_dyn name ]
+  | Select s -> constr "select" [ Select.to_dyn s ]
 
 let direct x = Direct x
 
+let re_export x = Re_export x
+
 let to_lib_names = function
   | Direct (_, s)
    |Re_export (_, s) ->
@@ -110,3 +112,18 @@ let decode =
     ~else_:
       (let+ loc, name = located Lib_name.decode in
        Direct (loc, name))
+
+let encode =
+  let open Dune_lang.Encoder in
+  function
+  | Direct (_, name) -> Lib_name.encode name
+  | Re_export (_, name) -> constr "re_export" Lib_name.encode name
+  | Select select ->
+    Code_error.raise "Lib_dep.encode: cannot encode select"
+      [ ("select", Select.to_dyn select) ]
+
+module L = struct
+  let field_encode t ~name =
+    let open Dune_lang.Encoder in
+    field_l name encode t
+end

src/dune/lib_dep.mli

@@ -25,8 +25,14 @@ val to_dyn : t -> Dyn.t
 
 val direct : Loc.t * Lib_name.t -> t
 
+val re_export : Loc.t * Lib_name.t -> t
+
 val to_lib_names : t -> Lib_name.t list
 
 val decode : t Dune_lang.Decoder.t
 
 val encode : t Dune_lang.Encoder.t
+
+module L : sig
+  val field_encode : t list -> name:string -> Dune_lang.Encoder.field
+end