Modules.t : Store module layout information (#2346)

Modules.t : Store module layout information

CHANGES.md

@@ -53,6 +53,9 @@
 - Set version in `META` and `dune-package` files to the one read from
   the vcs when no other version is available (#2224, @diml)
 
+- Fix dependency graph of wrapped_compat modules. Previously, the dependency on
+  the user written entry module was omitted. (#2305, @rgrinberg)
+
 1.10.0 (04/06/2019)
 -------------------
 

src/cinaps.ml

@@ -100,7 +100,10 @@ let gen_rules sctx t ~dir ~scope ~dir_kind =
       ~scope
       ~dir_kind
   in
-  let modules = Preprocessing.pp_modules preprocess modules in
+  let modules =
+    Modules.exe modules
+    |> Modules.map_user_written ~f:(Preprocessing.pp_module preprocess)
+  in
 
   let compile_info =
     Lib.DB.resolve_user_written_deps_for_exes

src/cm_files.ml

@@ -7,15 +7,8 @@ type t =
   ; ext_obj : string
   }
 
-let make_exe ~obj_dir ~modules ~top_sorted_modules ~ext_obj =
-  let modules = Module.Name_map.impl_only modules in
-  { obj_dir
-  ; modules
-  ; top_sorted_modules
-  ; ext_obj
-  }
-
-let make_lib ~obj_dir ~modules ~top_sorted_modules ~ext_obj =
+let make ~obj_dir ~modules ~top_sorted_modules ~ext_obj =
+  let modules = Modules.impl_only modules in
   { obj_dir
   ; modules
   ; top_sorted_modules

src/cm_files.mli

@@ -6,16 +6,9 @@ open Stdune
 
 type t
 
-val make_exe
+val make
   :  obj_dir:Path.Build.t Obj_dir.t
-  -> modules:Module.Name_map.t
-  -> top_sorted_modules:(unit, Module.t list) Build.t
-  -> ext_obj:string
-  -> t
-
-val make_lib
-  :  obj_dir:Path.Build.t Obj_dir.t
-  -> modules:Module.t list
+  -> modules:Modules.t
   -> top_sorted_modules:(unit, Module.t list) Build.t
   -> ext_obj:string
   -> t

src/compilation_context.ml

@@ -48,9 +48,7 @@ type t =
   ; expander             : Expander.t
   ; obj_dir              : Path.Build.t Obj_dir.t
   ; dir_kind             : Dune_lang.File_syntax.t
-  ; modules              : Module.t Module.Name.Map.t
-  ; alias_module         : Module.t option
-  ; lib_interface_module : Module.t option
+  ; modules              : Modules.t
   ; flags                : Ocaml_flags.t
   ; requires_compile     : Lib.t list Or_exn.t
   ; requires_link        : Lib.t list Or_exn.t Lazy.t
@@ -62,7 +60,6 @@ type t =
   ; js_of_ocaml          : Dune_file.Js_of_ocaml.t option
   ; dynlink              : bool
   ; sandbox              : bool option
-  ; vimpl                : Vimpl.t option
   ; package              : Package.t option
   }
 
@@ -73,8 +70,6 @@ let dir                  t = Obj_dir.dir t.obj_dir
 let dir_kind             t = t.dir_kind
 let obj_dir              t = t.obj_dir
 let modules              t = t.modules
-let alias_module         t = t.alias_module
-let lib_interface_module t = t.lib_interface_module
 let flags                t = t.flags
 let requires_compile     t = t.requires_compile
 let requires_link        t = Lazy.force t.requires_link
@@ -86,16 +81,13 @@ let stdlib               t = t.stdlib
 let js_of_ocaml          t = t.js_of_ocaml
 let dynlink              t = t.dynlink
 let sandbox              t = t.sandbox
-let vimpl                t = t.vimpl
 let package              t = t.package
 
 let context              t = Super_context.context t.super_context
 
 let create ~super_context ~scope ~expander ~obj_dir
-      ?vimpl
       ?(dir_kind=Dune_lang.File_syntax.Dune)
-      ~modules ?alias_module ?lib_interface_module ~flags
-      ~requires_compile ~requires_link
+      ~modules ~flags ~requires_compile ~requires_link
       ?(preprocessing=Preprocessing.dummy) ?(no_keep_locs=false)
       ~opaque ?stdlib ?js_of_ocaml ~dynlink ?sandbox ~package () =
   let requires_compile =
@@ -110,8 +102,6 @@ let create ~super_context ~scope ~expander ~obj_dir
   ; obj_dir
   ; dir_kind
   ; modules
-  ; alias_module
-  ; lib_interface_module
   ; flags
   ; requires_compile
   ; requires_link
@@ -121,7 +111,6 @@ let create ~super_context ~scope ~expander ~obj_dir
   ; opaque
   ; stdlib
   ; js_of_ocaml
-  ; vimpl
   ; dynlink
   ; sandbox
   ; package
@@ -141,15 +130,12 @@ let for_alias_module t =
       Ocaml_flags.append_common flags
         ["-w"; "-49"; "-nopervasives"; "-nostdlib"]
   ; includes     = Includes.empty
-  ; alias_module = None
   ; stdlib       = None
   ; sandbox      = Some sandbox
   }
 
-let for_wrapped_compat t modules =
+let for_wrapped_compat t =
   { t with
     includes = Includes.empty
-  ; alias_module = None
   ; stdlib = None
-  ; modules
   }

src/compilation_context.mli

@@ -18,11 +18,8 @@ val create
   -> scope                 : Scope.t
   -> expander              : Expander.t
   -> obj_dir               : Path.Build.t Obj_dir.t
-  -> ?vimpl                : Vimpl.t
   -> ?dir_kind             : Dune_lang.File_syntax.t
-  -> modules               : Module.t Module.Name.Map.t
-  -> ?alias_module         : Module.t
-  -> ?lib_interface_module : Module.t
+  -> modules               : Modules.t
   -> flags                 : Ocaml_flags.t
   -> requires_compile      : Lib.t list Or_exn.t
   -> requires_link         : Lib.t list Or_exn.t Lazy.t
@@ -47,9 +44,7 @@ val scope                : t -> Scope.t
 val dir                  : t -> Path.Build.t
 val dir_kind             : t -> Dune_lang.File_syntax.t
 val obj_dir              : t -> Path.Build.t Obj_dir.t
-val modules              : t -> Module.t Module.Name.Map.t
-val alias_module         : t -> Module.t option
-val lib_interface_module : t -> Module.t option
+val modules              : t -> Modules.t
 val flags                : t -> Ocaml_flags.t
 val requires_link        : t -> Lib.t list Or_exn.t
 val requires_compile     : t -> Lib.t list Or_exn.t
@@ -63,7 +58,4 @@ val dynlink              : t -> bool
 val sandbox              : t -> bool option
 val package              : t -> Package.t option
 
-(** Information for implementation of virtual libraries. *)
-val vimpl                : t -> Vimpl.t option
-
-val for_wrapped_compat : t -> Module.t Module.Name.Map.t -> t
+val for_wrapped_compat : t -> t

src/dep_graph.ml

@@ -49,35 +49,12 @@ let dummy (m : Module.t) =
   ; per_module = Module.Obj_map.singleton m (Build.return [])
   }
 
-let wrapped_compat ~modules ~wrapped_compat =
-  { dir = Path.Build.root
-  ; per_module =
-      Module.Name.Map.fold wrapped_compat ~init:Module.Obj_map.empty
-        ~f:(fun compat acc ->
-          let wrapped =
-            let name = Module.name compat in
-            match Module.Name.Map.find modules name with
-            | Some m -> m
-            | None ->
-              Code_error.raise "deprecated module needs counterpart"
-                [ "compat", Module.to_dyn compat ]
-          in
-          (* TODO this is wrong. The dependencies should be on the lib interface
-             whenever it exists *)
-          Module.Obj_map.set acc compat (Build.return [wrapped]))
-  }
-
 module Ml_kind = struct
   type nonrec t = t Ml_kind.Dict.t
 
   let dummy m =
     Ml_kind.Dict.make_both (dummy m)
 
-  let wrapped_compat =
-    let w = wrapped_compat in
-    fun ~modules ~wrapped_compat ->
-      Ml_kind.Dict.make_both (w ~modules ~wrapped_compat)
-
   let merge_impl ~(ml_kind : Ml_kind.t) _ vlib impl =
     Some (Ml_kind.choose ml_kind ~impl ~intf:vlib)
 

src/dep_graph.mli

@@ -24,10 +24,5 @@ module Ml_kind : sig
 
   val dummy : Module.t -> t
 
-  val wrapped_compat
-    :  modules:Module.t Module.Name.Map.t
-    -> wrapped_compat:Module.t Module.Name.Map.t
-    -> t
-
   val merge_for_impl : vlib:t -> impl:t -> t
 end

src/dir_contents.ml

@@ -4,14 +4,10 @@ module Menhir_rules = Menhir
 open Dune_file
 open! No_io
 
-module Executables_modules = struct
-  type t = Module.Name_map.t
-end
-
-module Modules = struct
+module Dir_modules = struct
   type t =
-    { libraries : Lib_modules.t Lib_name.Map.t
-    ; executables : Executables_modules.t String.Map.t
+    { libraries : Modules.t Lib_name.Map.t
+    ; executables : Modules.t String.Map.t
     ; (* Map from modules to the buildable they are part of *)
       rev_map : Buildable.t Module.Name.Map.t
     }
@@ -27,7 +23,7 @@ type t =
   { kind : kind
   ; dir : Path.Build.t
   ; text_files : String.Set.t
-  ; modules : Modules.t Memo.Lazy.t
+  ; modules : Dir_modules.t Memo.Lazy.t
   ; c_sources : C_sources.t Memo.Lazy.t
   ; mlds : (Dune_file.Documentation.t * Path.Build.t list) list Memo.Lazy.t
   ; coq_modules : Coq_module.t list Lib_name.Map.t Memo.Lazy.t
@@ -182,9 +178,9 @@ module rec Load : sig
 end = struct
   let virtual_modules sctx vlib =
     let info = Lib.info vlib in
-    let lib_modules =
+    let modules =
       match Option.value_exn (Lib_info.virtual_ info) with
-      | External lib_modules -> lib_modules
+      | External modules -> modules
       | Local ->
         let src_dir =
           Lib_info.src_dir info
@@ -193,13 +189,9 @@ end = struct
         let t = Load.get sctx ~dir:src_dir in
         modules_of_library t ~name:(Lib.name vlib)
     in
-    let existing_virtual_modules =
-      Lib_modules.virtual_modules lib_modules
-      |> Module.Name.Map.keys
-      |> Module.Name.Set.of_list
-    in
+    let existing_virtual_modules = Modules.virtual_module_names modules in
     let allow_new_public_modules =
-      Lib_modules.wrapped lib_modules
+      Modules.wrapped modules
       |> Wrapped.to_bool
       |> not
     in
@@ -281,8 +273,7 @@ end = struct
           in
           Left ( lib
                , let src_dir = Path.build src_dir in
-                 Lib_modules.make lib ~src_dir modules ~main_module_name
-                   ~wrapped
+                 Modules.lib ~lib ~src_dir ~modules ~main_module_name ~wrapped
                )
         | Executables exes
         | Tests { exes; _} ->
@@ -292,7 +283,7 @@ end = struct
               ~kind:Modules_field_evaluator.Exe_or_normal_lib
               ~private_modules:Ordered_set_lang.standard
           in
-          Right (exes, modules)
+          Right (exes, Modules.exe modules)
         | _ -> Skip)
     in
     let libraries =
@@ -322,14 +313,13 @@ end = struct
     in
     let rev_map =
       let rev_modules =
+        let by_name buildable =
+          Modules.fold_user_written ~init:[] ~f:(fun m acc ->
+            (Module.name m, buildable) :: acc)
+        in
         List.rev_append
-          (List.concat_map libs ~f:(fun (l, m) ->
-             let modules = Lib_modules.modules m in
-             List.map (Module.Name.Map.values modules) ~f:(fun m ->
-               (Module.name m, l.buildable))))
-          (List.concat_map exes ~f:(fun (e, m) ->
-             List.map (Module.Name.Map.values m) ~f:(fun m ->
-               (Module.name m, e.buildable))))
+          (List.concat_map libs ~f:(fun (l, m) -> by_name l.buildable m))
+          (List.concat_map exes ~f:(fun (e, m) -> by_name e.buildable m))
       in
       match d.kind with
       | Dune -> begin
@@ -383,7 +373,7 @@ end = struct
               ];
             b)
     in
-    { Modules. libraries; executables; rev_map }
+    { Dir_modules. libraries; executables; rev_map }
 
   (* As a side-effect, setup user rules and copy_files rules. *)
   let load_text_files sctx ft_dir
@@ -495,7 +485,7 @@ end = struct
            t = { kind = Standalone
                ; dir
                ; text_files = String.Set.empty
-               ; modules = Memo.Lazy.of_val Modules.empty
+               ; modules = Memo.Lazy.of_val Dir_modules.empty
                ; mlds = Memo.Lazy.of_val []
                ; c_sources = Memo.Lazy.of_val C_sources.empty
                ; coq_modules = Memo.Lazy.of_val Lib_name.Map.empty

src/dir_contents.mli

@@ -16,17 +16,13 @@ val dir : t -> Path.Build.t
     [ocamlyacc], [menhir] stanzas. *)
 val text_files : t -> String.Set.t
 
-module Executables_modules : sig
-  type t = Module.Name_map.t
-end
-
 (** Modules attached to a library. [name] is the library best name. *)
-val modules_of_library : t -> name:Lib_name.t -> Lib_modules.t
+val modules_of_library : t -> name:Lib_name.t -> Modules.t
 
 val c_sources_of_library : t -> name:Lib_name.t -> C.Sources.t
 
 (** Modules attached to a set of executables. *)
-val modules_of_executables : t -> first_exe:string -> Executables_modules.t
+val modules_of_executables : t -> first_exe:string -> Modules.t
 
 (** Find out what buildable a module is part of *)
 val lookup_module : t -> Module.Name.t -> Dune_file.Buildable.t option

src/dune_file.ml

@@ -1252,16 +1252,6 @@ module Library = struct
     | None, This (Simple false) -> This None
     | None, This (Simple true | Yes_with_transition _) ->
       This (Some (Module.Name.of_local_lib_name (snd t.name)))
-
-  let special_compiler_module t (m : Module.t) =
-    match t.stdlib with
-    | None -> false
-    | Some stdlib ->
-      let name = Module.name m in
-      Glob.test stdlib.internal_modules (Module.Name.to_string name) ||
-      match stdlib.exit_module with
-      | None -> false
-      | Some n -> n = name
 end
 
 module Install_conf = struct

src/dune_file.mli

@@ -286,12 +286,6 @@ module Library : sig
   end
 
   val main_module_name : t -> Main_module_name.t
-
-  (** Returns [true] is a special module, i.e. one whose compilation
-      unit name is hard-coded inside the compiler. It is not possible
-      to change the compilation unit name of such modules, so they
-      cannot be wrapped. *)
-  val special_compiler_module : t -> Module.t -> bool
 end
 
 module Install_conf : sig