From 3452100664e93be0b10d02fdc544d83ee93beadf Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Fri, 20 Nov 2020 18:47:42 -0800
Subject: [PATCH] add some gross hacks for builtin modules

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 src/dune_rules/findlib/findlib.ml | 62 ++++++++++++++++---------------
 src/dune_rules/findlib/meta.ml    | 13 ++++++-
 2 files changed, 44 insertions(+), 31 deletions(-)

diff --git a/src/dune_rules/findlib/findlib.ml b/src/dune_rules/findlib/findlib.ml
index b97b1331fcb6..a2d5c732d0ec 100644
--- a/src/dune_rules/findlib/findlib.ml
+++ b/src/dune_rules/findlib/findlib.ml
@@ -376,35 +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 -> (
-                    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) )) )
+            ( 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
index e7ffdfe6b370..fcf327542124 100644
--- a/src/dune_rules/findlib/meta.ml
+++ b/src/dune_rules/findlib/meta.ml
@@ -141,6 +141,10 @@ 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 name =
+  rule "main_modules" [] Set (String.capitalize_ascii name)
+
 let builtins ~stdlib_dir ~version:ocaml_version =
   let version = version "[distributed with Ocaml]" in
   let simple name ?dir ?archive_name deps =
@@ -149,11 +153,12 @@ let builtins ~stdlib_dir ~version:ocaml_version =
       | None -> name
       | Some a -> a
     in
+    let main_modules = main_modules name in
     let name = Lib_name.of_string name in
     let archives = archives archive_name in
     { name = Some name
     ; entries =
-        requires deps :: version
+        requires deps :: version :: main_modules
         ::
         ( match dir with
         | None -> archives
@@ -161,7 +166,9 @@ let builtins ~stdlib_dir ~version:ocaml_version =
     }
   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 =
@@ -200,6 +207,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 +227,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")
         ]