Switch to rename proposal

Signed-off-by: Rudi Grinberg <[email protected]>

src/dune_rules/compilation_context.ml

@@ -70,7 +70,7 @@ type t =
   ; vimpl : Vimpl.t option
   ; modes : Mode.Dict.Set.t
   ; bin_annot : bool
-  ; extra_aliases : (Module_name.t * Module_name.t) list
+  ; renames : (Lib.t * Module_name.t) list Or_exn.t
   }
 
 let super_context t = t.super_context
@@ -115,10 +115,31 @@ let bin_annot t = t.bin_annot
 
 let context t = Super_context.context t.super_context
 
+type rename =
+  { new_name : Module_name.t
+  ; toplevel_modules : Module_name.t list
+  }
+
+let renames t =
+  let open Result.O in
+  let* renames = t.renames in
+  Result.List.map renames ~f:(fun (lib, new_name) ->
+      let* main_module_name = Lib.main_module_name lib in
+      let+ toplevel_modules =
+        match main_module_name with
+        | Some m -> Ok [ m ]
+        | None ->
+          Error
+            (User_error.E
+               (User_error.make
+                  [ Pp.text "renaming unwrapped not supported yet" ]))
+      in
+      { new_name; toplevel_modules })
+
 let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags
     ~requires_compile ~requires_link ?(preprocessing = Preprocessing.dummy)
     ~opaque ?stdlib ~js_of_ocaml ~dynlink ~package ?vimpl ?modes
-    ?(bin_annot = true) ?(extra_aliases = []) () =
+    ?(bin_annot = true) ?(renames = Ok []) () =
   let requires_compile =
     if Dune_project.implicit_transitive_deps (Scope.project scope) then
       Lazy.force requires_link
@@ -158,7 +179,7 @@ let create ~super_context ~scope ~expander ~obj_dir ~modules ~flags
   ; vimpl
   ; modes
   ; bin_annot
-  ; extra_aliases
+  ; renames
   }
 
 let for_alias_module t =
@@ -215,5 +236,3 @@ let for_plugin_executable t ~embed_in_plugin_libraries =
   { t with requires_link }
 
 let without_bin_annot t = { t with bin_annot = false }
-
-let extra_aliases t = t.extra_aliases

src/dune_rules/compilation_context.mli

@@ -40,7 +40,7 @@ val create :
   -> ?vimpl:Vimpl.t
   -> ?modes:Dune_file.Mode_conf.Set.Details.t Mode.Dict.t
   -> ?bin_annot:bool
-  -> ?extra_aliases:(Module_name.t * Module_name.t) list
+  -> ?renames:(Lib.t * Module_name.t) list Or_exn.t
   -> unit
   -> t
 
@@ -101,4 +101,9 @@ val bin_annot : t -> bool
 
 val without_bin_annot : t -> t
 
-val extra_aliases : t -> (Module_name.t * Module_name.t) list
+type rename =
+  { new_name : Module_name.t
+  ; toplevel_modules : Module_name.t list
+  }
+
+val renames : t -> rename list Or_exn.t

src/dune_rules/dir_contents.ml

@@ -155,6 +155,7 @@ end = struct
             (* Manually add files generated by the (select ...) dependencies *)
             List.filter_map buildable.libraries ~f:(fun dep ->
                 match (dep : Lib_dep.t) with
+                | Rename _
                 | Re_export _
                 | Direct _ ->
                   None

src/dune_rules/dune_file.ml

@@ -85,6 +85,7 @@ module Lib_deps = struct
     ignore
       ( List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x ->
             match x with
+            | Lib_dep.Rename ((_, s), _)
             | Lib_dep.Re_export (_, s)
             | Lib_dep.Direct (_, s) ->
               add Required s acc
@@ -102,8 +103,9 @@ module Lib_deps = struct
 
   let info t ~kind =
     List.concat_map t ~f:(function
-      | Lib_dep.Re_export (_, s)
-      | Lib_dep.Direct (_, s) ->
+      | Lib_dep.Rename ((_, s), _)
+      | Re_export (_, s)
+      | Direct (_, s) ->
         [ (s, kind) ]
       | Select { choices; _ } ->
         List.concat_map choices ~f:(fun (c : Lib_dep.Select.Choice.t) ->
@@ -161,7 +163,6 @@ module Buildable = struct
     ; flags : Ocaml_flags.Spec.t
     ; js_of_ocaml : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
-    ; extra_aliases : (Module_name.t * Module_name.t) list
     }
 
   let decode ~in_library ~allow_re_export =
@@ -233,13 +234,6 @@ module Buildable = struct
         (multi_field "instrumentation"
            ( Dune_lang.Syntax.since Stanza.syntax (2, 7)
            >>> fields (field "backend" (located Lib_name.decode)) ))
-    and+ extra_aliases =
-      field ~default:[] "extra_aliases"
-        (enter
-           (repeat
-              (let+ from = Module_name.decode
-               and+ to_ = Module_name.decode in
-               (from, to_))))
     in
     let preprocess =
       let init =
@@ -293,7 +287,6 @@ module Buildable = struct
     ; flags
     ; js_of_ocaml
     ; allow_overlapping_dependencies
-    ; extra_aliases
     }
 
   let has_foreign t =

src/dune_rules/dune_file.mli

@@ -49,7 +49,6 @@ module Buildable : sig
     ; flags : Ocaml_flags.Spec.t
     ; js_of_ocaml : Js_of_ocaml.t
     ; allow_overlapping_dependencies : bool
-    ; extra_aliases : (Module_name.t * Module_name.t) list
     }
 
   (** Check if the buildable has any foreign stubs or archives. *)

src/dune_rules/lib.ml

@@ -240,6 +240,7 @@ module T = struct
     ; unique_id : Id.t
     ; re_exports : t list Or_exn.t
     ; requires : t list Or_exn.t
+    ; renames : (t * Module_name.t) list Or_exn.t
     ; ppx_runtime_deps : t list Or_exn.t
     ; pps : t list Or_exn.t
     ; resolved_selects : Resolved_select.t list
@@ -952,6 +953,7 @@ module rec Resolve : sig
     ; pps : lib list Or_exn.t
     ; selects : Resolved_select.t list
     ; re_exports : lib list Or_exn.t
+    ; renames : (lib * Module_name.t) list Or_exn.t
     }
 
   val resolve_deps_and_add_runtime_deps :
@@ -1045,7 +1047,7 @@ end = struct
                             (Package.Name.to_string p')
                         ] )))
     in
-    let { requires; pps; selects = resolved_selects; re_exports } =
+    let { requires; pps; selects = resolved_selects; re_exports; renames } =
       let pps =
         Preprocess.Per_module.pps
           (Preprocess.Per_module.with_instrumentation (Lib_info.preprocess info)
@@ -1091,6 +1093,7 @@ end = struct
       ; default_implementation
       ; lib_config = db.lib_config
       ; re_exports
+      ; renames
       }
     in
     t.sub_systems <-
@@ -1191,13 +1194,15 @@ end = struct
     { resolved : t list Or_exn.t
     ; selects : Resolved_select.t list
     ; re_exports : t list Or_exn.t
+    ; renames : (lib * Module_name.t) list Or_exn.t
     }
 
   type resolved =
     { requires : lib list Or_exn.t
     ; pps : lib list Or_exn.t
     ; selects : Resolved_select.t list
     ; re_exports : lib list Or_exn.t
+    ; renames : (lib * Module_name.t) list Or_exn.t
     }
 
   let resolve_complex_deps db deps ~allow_private_deps ~stack : resolved_deps =
@@ -1226,9 +1231,9 @@ end = struct
       in
       (res, { Resolved_select.src_fn; dst_fn = result_fn })
     in
-    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, resolved_selects, re_exports, renames =
+      List.fold_left deps ~init:(Ok [], [], Ok [], Ok [])
+        ~f:(fun (acc_res, acc_selects, acc_re_exports, acc_renames) dep ->
           match (dep : Lib_dep.t) with
           | Re_export (loc, name) ->
             let lib = resolve_dep db (loc, name) ~allow_private_deps ~stack in
@@ -1242,26 +1247,43 @@ end = struct
               and+ acc_res = acc_res in
               lib :: acc_res
             in
-            (acc_res, acc_selects, acc_re_exports)
+            (acc_res, acc_selects, acc_re_exports, acc_renames)
+          | Rename ((loc, name), to_) ->
+            let lib = resolve_dep db (loc, name) ~allow_private_deps ~stack in
+            let acc_res =
+              let+ lib = lib
+              and+ acc_res = acc_res in
+              lib :: acc_res
+            in
+            let acc_renames =
+              let+ lib = lib
+              and+ acc_renames = acc_renames in
+              (lib, to_) :: acc_renames
+            in
+            (acc_res, acc_selects, acc_re_exports, acc_renames)
           | Direct (loc, name) ->
             let acc_res =
               let+ lib = resolve_dep db (loc, name) ~allow_private_deps ~stack
               and+ acc_res = acc_res in
               lib :: acc_res
             in
-            (acc_res, acc_selects, acc_re_exports)
+            (acc_res, acc_selects, acc_re_exports, acc_renames)
           | Select select ->
             let res, resolved_select = resolve_select select in
             let acc_res =
               let+ res = res
               and+ acc_res = acc_res in
               List.rev_append res acc_res
             in
-            (acc_res, resolved_select :: acc_selects, acc_re_exports))
+            ( acc_res
+            , resolved_select :: acc_selects
+            , acc_re_exports
+            , acc_renames ))
     in
     let res = Result.map ~f:List.rev res in
     let re_exports = Result.map ~f:List.rev re_exports in
-    { resolved = res; selects = resolved_selects; re_exports }
+    let renames = Result.map ~f:List.rev renames in
+    { resolved = res; selects = resolved_selects; re_exports; renames }
 
   type pp_deps =
     { pps : t list Or_exn.t
@@ -1330,6 +1352,7 @@ end = struct
     ; pps
     ; selects = resolved.selects
     ; re_exports = resolved.re_exports
+    ; renames = resolved.renames
     }
 
   let resolve_deps_and_add_runtime_deps db deps ~allow_private_deps ~pps
@@ -1545,8 +1568,11 @@ module Compile = struct
     ; resolved_selects : Resolved_select.t list
     ; lib_deps_info : Lib_deps_info.t
     ; sub_systems : Sub_system0.Instance.t Lazy.t Sub_system_name.Map.t
+    ; renames : (lib * Module_name.t) list Or_exn.t
     }
 
+  let renames t = t.renames
+
   let make_lib_deps_info ~user_written_deps ~pps ~kind =
     Lib_deps_info.merge
       (Dune_file.Lib_deps.info user_written_deps ~kind)
@@ -1598,6 +1624,7 @@ module Compile = struct
     ; pps = t.pps
     ; lib_deps_info
     ; sub_systems = t.sub_systems
+    ; renames = t.renames
     }
 
   let direct_requires t = t.direct_requires
@@ -1733,6 +1760,7 @@ module DB = struct
         ; pps
         ; selects = resolved_selects
         ; re_exports = _
+        ; renames
         } =
       Resolve.resolve_deps_and_add_runtime_deps t deps ~pps
         ~allow_private_deps:true ~stack:Dep_stack.empty
@@ -1766,6 +1794,7 @@ module DB = struct
     ; resolved_selects
     ; lib_deps_info
     ; sub_systems = Sub_system_name.Map.empty
+    ; renames
     }
 
   (* Here we omit the [only_ppx_deps_allowed] check because by the time we reach

src/dune_rules/lib.mli

@@ -115,6 +115,8 @@ type sub_system = ..
 module Compile : sig
   type t
 
+  type lib
+
   (** Return the list of dependencies needed for linking this library/exe *)
   val requires_link : t -> L.t Or_exn.t Lazy.t
 
@@ -138,7 +140,10 @@ module Compile : sig
 
   (** Sub-systems used in this compilation context *)
   val sub_systems : t -> sub_system list
+
+  val renames : t -> (lib * Module_name.t) list Or_exn.t
 end
+with type lib := t
 
 (** {1 Library name resolution} *)
 

src/dune_rules/lib_dep.ml

@@ -1,6 +1,21 @@
 open! Dune_engine
 open Stdune
 
+module Rename = struct
+  type t = (Loc.t * Lib_name.t) * Module_name.t
+
+  let decode : t Dune_lang.Decoder.t =
+    let open Dune_lang.Decoder in
+    let+ lib = Lib_name.decode_loc
+    and+ () = keyword "->"
+    and+ module_name = Module_name.decode in
+    (lib, module_name)
+
+  let to_dyn ((_, name), m) =
+    let open Dyn.Encoder in
+    pair Lib_name.to_dyn Module_name.to_dyn (name, m)
+end
+
 module Select = struct
   module Choice = struct
     type t =
@@ -99,28 +114,20 @@ type t =
   | Direct of (Loc.t * Lib_name.t)
   | Re_export of (Loc.t * Lib_name.t)
   | Select of Select.t
+  | Rename of Rename.t
 
 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 ]
+  | Rename s -> constr "rename" [ Rename.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) ->
-    [ s ]
-  | Select s ->
-    List.fold_left s.choices ~init:Lib_name.Set.empty
-      ~f:(fun acc (x : Select.Choice.t) ->
-        Lib_name.Set.union acc (Lib_name.Set.union x.required x.forbidden))
-    |> Lib_name.Set.to_list
-
 let decode ~allow_re_export =
   let open Dune_lang.Decoder in
   let+ loc, t =
@@ -133,6 +140,10 @@ let decode ~allow_re_export =
           ; ( "select"
             , let+ select = Select.decode in
               Select select )
+          ; ( "rename"
+            , let+ () = Dune_lang.Syntax.since Stanza.syntax (2, 8)
+              and+ rename = Rename.decode in
+              Rename rename )
           ]
       <|> let+ loc, name = located Lib_name.decode in
           Direct (loc, name) )
@@ -150,6 +161,9 @@ let encode =
   | Select select ->
     Code_error.raise "Lib_dep.encode: cannot encode select"
       [ ("select", Select.to_dyn select) ]
+  | Rename rename ->
+    Code_error.raise "Lib_dep.encode: cannot encode rename"
+      [ ("rename", Rename.to_dyn rename) ]
 
 module L = struct
   let field_encode t ~name =