gross hacks for builtin & mangled modules

* Hide modules with __ root_module * Populate module lists manually for some built in libraries Signed-off-by: Rudi Grinberg <[email protected]>
ocaml · Nov 23, 2020 · 2cb4b96 · 2cb4b96
1 parent a006048
commit 2cb4b96
Show file tree

Hide file tree

Showing 3 changed files with 61 additions and 28 deletions.
diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml
@@ -247,6 +247,11 @@ end = struct
         (make_archives t "archive" (Ps.add preds Variant.plugin))
         (make_archives t "plugin" preds)
 
+    let mangled_module_re =
+      lazy
+        (let open Re in
+        [ rep any; str "__"; rep any ] |> seq |> compile)
+
     let exists t ~is_builtin =
       let exists_if = Vars.get_words t.vars "exists_if" Ps.empty in
       match exists_if with
@@ -371,28 +376,39 @@ end = struct
         in
         let entry_modules =
           Lib_info.Source.External
-            ( match dir_contents with
-            | Error e ->
-              Error
-                (User_error.E
-                   (User_message.make
-                      [ Pp.textf "Unable to get entry modules of %s in %s. "
-                          (Lib_name.to_string t.name)
-                          (Path.to_string src_dir)
-                      ; Pp.textf "error: %s" (Unix.error_message e)
-                      ]))
-            | Ok files ->
-              let ext = Cm_kind.ext Cmi in
-              Result.List.filter_map files ~f:(fun fname ->
-                  match Filename.check_suffix fname ext with
-                  | false -> Ok None
-                  | true -> (
-                    match
-                      let name = Filename.chop_extension fname in
-                      Module_name.of_string_user_error (Loc.in_dir src_dir, name)
-                    with
-                    | Ok s -> Ok (Some s)
-                    | Error e -> Error (User_error.E e) )) )
+            ( match Vars.get_words t.vars "main_modules" Ps.empty with
+            | _ :: _ as modules ->
+              Ok (List.map ~f:Module_name.of_string modules)
+            | [] -> (
+              match dir_contents with
+              | Error e ->
+                Error
+                  (User_error.E
+                     (User_message.make
+                        [ Pp.textf "Unable to get entry modules of %s in %s. "
+                            (Lib_name.to_string t.name)
+                            (Path.to_string src_dir)
+                        ; Pp.textf "error: %s" (Unix.error_message e)
+                        ]))
+              | Ok files ->
+                let ext = Cm_kind.ext Cmi in
+                Result.List.filter_map files ~f:(fun fname ->
+                    match Filename.check_suffix fname ext with
+                    | false -> Ok None
+                    | true -> (
+                      if
+                        (* We add this hack to skip manually mangled libraries *)
+                        Re.execp (Lazy.force mangled_module_re) fname
+                      then
+                        Ok None
+                      else
+                        match
+                          let name = Filename.chop_extension fname in
+                          Module_name.of_string_user_error
+                            (Loc.in_dir src_dir, name)
+                        with
+                        | Ok s -> Ok (Some s)
+                        | Error e -> Error (User_error.E e) )) ) )
         in
         Lib_info.create ~loc ~name:t.name ~kind ~status ~src_dir ~orig_src_dir
           ~obj_dir ~version ~synopsis ~main_module_name ~sub_systems ~requires

diff --git a/src/dune_rules/findlib/meta.ml b/src/dune_rules/findlib/meta.ml
@@ -141,27 +141,41 @@ let archives name =
   ; plugin "native" (name ^ Mode.plugin_ext Native)
   ]
 
+(* fake entry we use to pass down the list of toplevel modules for root_module *)
+let main_modules names =
+  List.map ~f:String.capitalize_ascii names
+  |> String.concat ~sep:" " |> rule "main_modules" [] Set
+
 let builtins ~stdlib_dir ~version:ocaml_version =
   let version = version "[distributed with Ocaml]" in
-  let simple name ?dir ?archive_name deps =
+  let simple name ?(labels = false) ?dir ?archive_name deps =
     let archive_name =
       match archive_name with
       | None -> name
       | Some a -> a
     in
+    let main_modules =
+      if labels then
+        main_modules [ name; name ^ "Labels" ]
+      else
+        main_modules [ name ]
+    in
     let name = Lib_name.of_string name in
     let archives = archives archive_name in
+    let main_modules = main_modules in
     { name = Some name
     ; entries =
-        requires deps :: version
+        requires deps :: version :: main_modules
         ::
         ( match dir with
         | None -> archives
         | Some d -> directory d :: archives )
     }
   in
   let dummy name =
-    { name = Some (Lib_name.of_string name); entries = [ version ] }
+    { name = Some (Lib_name.of_string name)
+    ; entries = [ version; main_modules [ name ] ]
+    }
   in
   let compiler_libs =
     let sub name deps =
@@ -181,7 +195,7 @@ let builtins ~stdlib_dir ~version:ocaml_version =
   in
   let stdlib = dummy "stdlib" in
   let str = simple "str" [] ~dir:"+" in
-  let unix = simple "unix" [] ~dir:"+" in
+  let unix = simple ~labels:true "unix" [] ~dir:"+" in
   let bigarray =
     if
       Ocaml_version.stdlib_includes_bigarray ocaml_version
@@ -200,6 +214,7 @@ let builtins ~stdlib_dir ~version:ocaml_version =
     { name = Some (Lib_name.of_string "threads")
     ; entries =
         [ version
+        ; main_modules [ "thread" ]
         ; requires ~preds:[ Pos "mt"; Pos "mt_vm" ] [ "threads.vm" ]
         ; requires ~preds:[ Pos "mt"; Pos "mt_posix" ] [ "threads.posix" ]
         ; directory "+"
@@ -219,6 +234,7 @@ let builtins ~stdlib_dir ~version:ocaml_version =
     { name = Some (Lib_name.of_string "num")
     ; entries =
         [ requires [ "num.core" ]
+        ; main_modules [ "num" ]
         ; version
         ; Package (simple "core" [] ~dir:"+" ~archive_name:"nums")
         ]

diff --git a/test/blackbox-tests/test-cases/root-module.t b/test/blackbox-tests/test-cases/root-module.t
@@ -48,12 +48,13 @@ We can use the rename dependency type to use lib1 with a different name:
 
   $ cat >lib2/dune <<EOF
   > (library
-  >  (libraries lib1)
+  >  (libraries lib1 unix)
   >  (root_module root)
   >  (name lib2))
   > EOF
   $ cat >lib2/lib2.ml <<EOF
-  > print_endline Root.Lib1.greeting
+  > module U = UnixLabels
+  > let () = print_endline Root.Lib1.greeting
   > EOF
   $ dune build @all