Introduce Lib_name.t and Lib_name.Local.t types

These types help distinguish external and internal library names

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

bin/main.ml

@@ -582,7 +582,10 @@ let installed_libraries =
        let ctx = List.hd ctxs in
        let findlib = ctx.findlib in
        if na then begin
-         let pkgs = Findlib.all_unavailable_packages findlib in
+         let pkgs =
+           Findlib.all_unavailable_packages findlib
+           |> List.map ~f:(fun (l, e) -> (Lib_name.to_string l, e))
+         in
          let longest = String.longest_map pkgs ~f:fst in
          let ppf = Format.std_formatter in
          List.iter pkgs ~f:(fun (n, r) ->
@@ -592,13 +595,15 @@ let installed_libraries =
          Fiber.return ()
        end else begin
          let pkgs = Findlib.all_packages findlib in
-         let max_len = String.longest_map pkgs ~f:Findlib.Package.name in
+         let max_len = String.longest_map pkgs ~f:(fun n ->
+           Findlib.Package.name n
+           |> Lib_name.to_string) in
          List.iter pkgs ~f:(fun pkg ->
            let ver =
              Option.value (Findlib.Package.version pkg) ~default:"n/a"
            in
            Printf.printf "%-*s (version: %s)\n" max_len
-             (Findlib.Package.name pkg) ver);
+             (Lib_name.to_string (Findlib.Package.name pkg)) ver);
          Fiber.return ()
        end)
   in
@@ -829,11 +834,11 @@ let clean =
   (term, Term.info "clean" ~doc ~man)
 
 let format_external_libs libs =
-  String.Map.to_list libs
+  Lib_name.Map.to_list libs
   |> List.map ~f:(fun (name, kind) ->
     match (kind : Lib_deps_info.Kind.t) with
-    | Optional -> sprintf "- %s (optional)" name
-    | Required -> sprintf "- %s" name)
+    | Optional -> sprintf "- %s (optional)" (Lib_name.to_string name)
+    | Required -> sprintf "- %s" (Lib_name.to_string name))
   |> String.concat ~sep:"\n"
 
 let external_lib_deps =
@@ -876,20 +881,20 @@ let external_lib_deps =
                   | Some x -> x)
              in
              let externals =
-               String.Map.filteri lib_deps ~f:(fun name _ ->
-                 not (String.Set.mem internals name))
+               Lib_name.Map.filteri lib_deps ~f:(fun name _ ->
+                 not (Lib_name.Set.mem internals name))
              in
              if only_missing then begin
                let context =
                  List.find_exn setup.contexts ~f:(fun c -> c.name = context_name)
                in
                let missing =
-                 String.Map.filteri externals ~f:(fun name _ ->
+                 Lib_name.Map.filteri externals ~f:(fun name _ ->
                    not (Findlib.available context.findlib name))
                in
-               if String.Map.is_empty missing then
+               if Lib_name.Map.is_empty missing then
                  acc
-               else if String.Map.for_alli missing
+               else if Lib_name.Map.for_alli missing
                          ~f:(fun _ kind -> kind = Lib_deps_info.Kind.Optional)
                then begin
                  Format.eprintf
@@ -907,13 +912,14 @@ let external_lib_deps =
                     Hint: try: opam install %s@."
                    context_name
                    (format_external_libs missing)
-                   (String.Map.to_list missing
+                   (Lib_name.Map.to_list missing
                     |> List.filter_map ~f:(fun (name, kind) ->
                       match (kind : Lib_deps_info.Kind.t) with
                       | Optional -> None
-                      | Required -> Some (Findlib.root_package_name name))
-                    |> String.Set.of_list
-                    |> String.Set.to_list
+                      | Required -> Some (Lib_name.package_name name))
+                    |> Package.Name.Set.of_list
+                    |> Package.Name.Set.to_list
+                    |> List.map ~f:Package.Name.to_string
                     |> String.concat ~sep:" ");
                  true
                end

src/artifacts.ml

@@ -75,20 +75,18 @@ let file_of_lib t ~loc ~lib ~file =
   match Lib.DB.find t.public_libs lib with
   | Error reason ->
     Error { fail = fun () ->
-      Lib.not_available ~loc reason "Public library %S" lib  }
+      Lib.not_available ~loc reason "Public library %a" Lib_name.pp_quoted lib }
   | Ok lib ->
     if Lib.is_local lib then begin
-      match String.split (Lib.name lib) ~on:'.' with
-      | [] -> assert false
-      | package :: rest ->
-        let lib_install_dir =
-          Config.local_install_lib_dir ~context:t.context.name ~package
-        in
-        let lib_install_dir =
-          match rest with
-          | [] -> lib_install_dir
-          | _  -> Path.relative lib_install_dir (String.concat rest ~sep:"/")
-        in
-        Ok (Path.relative lib_install_dir file)
+      let (package, rest) = Lib_name.split (Lib.name lib) in
+      let lib_install_dir =
+        Config.local_install_lib_dir ~context:t.context.name ~package
+      in
+      let lib_install_dir =
+        match rest with
+        | [] -> lib_install_dir
+        | _  -> Path.relative lib_install_dir (String.concat rest ~sep:"/")
+      in
+      Ok (Path.relative lib_install_dir file)
     end else
       Ok (Path.relative (Lib.src_dir lib) file)

src/artifacts.mli

@@ -26,6 +26,6 @@ val binary
 val file_of_lib
   :  t
   -> loc:Loc.t
-  -> lib:string
+  -> lib:Lib_name.t
   -> file:string
   -> (Path.t, fail) result

src/build_interpret.ml

@@ -156,7 +156,7 @@ let lib_deps =
       | Catch (t, _) -> loop t acc
       | Lazy_no_targets t -> loop (Lazy.force t) acc
   in
-  fun t -> loop (Build.repr t) String.Map.empty
+  fun t -> loop (Build.repr t) Lib_name.Map.empty
 
 let targets =
   let rec loop : type a b. (a, b) t -> Target.t list -> Target.t list = fun t acc ->

src/build_system.ml

@@ -1332,7 +1332,7 @@ let all_lib_deps t ~request =
   List.fold_left (rules_for_targets t targets) ~init:Path.Map.empty
     ~f:(fun acc rule ->
       let deps = Internal_rule.lib_deps rule in
-      if String.Map.is_empty deps then
+      if Lib_name.Map.is_empty deps then
         acc
       else
         let deps =
@@ -1347,7 +1347,7 @@ let all_lib_deps_by_context t ~request =
   let rules = rules_for_targets t targets in
   List.fold_left rules ~init:[] ~f:(fun acc rule ->
     let deps = Internal_rule.lib_deps rule in
-    if String.Map.is_empty deps then
+    if Lib_name.Map.is_empty deps then
       acc
     else
       match Path.extract_build_context rule.dir with
@@ -1356,7 +1356,7 @@ let all_lib_deps_by_context t ~request =
   |> String.Map.of_list_multi
   |> String.Map.filteri ~f:(fun ctx _ -> String.Map.mem t.contexts ctx)
   |> String.Map.map ~f:(function
-    | [] -> String.Map.empty
+    | [] -> Lib_name.Map.empty
     | x :: l -> List.fold_left l ~init:x ~f:Lib_deps_info.merge)
 
 module Rule = struct

src/config.ml

@@ -14,7 +14,7 @@ let local_install_man_dir ~context =
 let local_install_lib_dir ~context ~package =
   Path.relative
     (Path.relative (local_install_dir ~context) "lib")
-    package
+    (Package.Name.to_string package)
 
 let dev_null =
   Path.of_filename_relative_to_initial_cwd

src/config.mli

@@ -7,7 +7,7 @@ val local_install_dir : context:string -> Path.t
 
 val local_install_bin_dir : context:string -> Path.t
 val local_install_man_dir : context:string -> Path.t
-val local_install_lib_dir : context:string -> package:string -> Path.t
+val local_install_lib_dir : context:string -> package:Package.Name.t -> Path.t
 
 val dev_null : Path.t
 

src/dep_path.ml

@@ -4,19 +4,20 @@ module Entry = struct
   type t =
     | Path of Path.t
     | Alias of Path.t
-    | Library of Path.t * string
-    | Preprocess of string list
+    | Library of Path.t * Lib_name.t
+    | Preprocess of Lib_name.t list
     | Loc of Loc.t
 
   let to_string = function
     | Path p -> Utils.describe_target p
     | Alias p -> "alias " ^ Utils.describe_target p
     | Library (path, lib_name) ->
-      sprintf "library %S in %s" lib_name (Path.to_string_maybe_quoted path)
+      Format.asprintf "library %a in %s" Lib_name.pp_quoted lib_name
+        (Path.to_string_maybe_quoted path)
     | Preprocess l ->
       Sexp.to_string
         (List [ Atom "pps"
-              ; Sexp.To_sexp.(list string) l])
+              ; Sexp.To_sexp.(list Lib_name.to_sexp) l])
     | Loc loc ->
       Loc.to_file_colon_line loc
 

src/dep_path.mli

@@ -6,8 +6,8 @@ module Entry : sig
   type t =
     | Path of Path.t
     | Alias of Path.t
-    | Library of Path.t * string
-    | Preprocess of string list
+    | Library of Path.t * Lib_name.t
+    | Preprocess of Lib_name.t list
     | Loc of Loc.t
 
   val to_string : t -> string

src/dir_contents.ml

@@ -179,7 +179,8 @@ end = struct
     }
 
   let make (lib : Library.t) ~dir (modules : Module.t Module.Name.Map.t) =
-    let main_module_name = Module.Name.of_string lib.name in
+    let main_module_name =
+      Module.Name.of_string (Lib_name.Local.to_string lib.name) in
     let modules =
       if not lib.wrapped then
         modules
@@ -192,6 +193,7 @@ end = struct
             Module.with_wrapper m ~libname:lib.name)
     in
     let alias_module =
+      let lib_name = Lib_name.Local.to_string lib.name in
       if not lib.wrapped ||
          (Module.Name.Map.cardinal modules = 1 &&
           Module.Name.Map.mem modules main_module_name) then
@@ -204,14 +206,14 @@ end = struct
         Some
           (Module.make (Module.Name.add_suffix main_module_name "__")
              ~impl:(Module.File.make OCaml
-                      (Path.relative dir (sprintf "%s__.ml-gen" lib.name)))
-             ~obj_name:(lib.name ^ "__"))
+                      (Path.relative dir (sprintf "%s__.ml-gen" lib_name)))
+             ~obj_name:(lib_name ^ "__"))
       else
         Some
           (Module.make main_module_name
              ~impl:(Module.File.make OCaml
-                      (Path.relative dir (lib.name ^ ".ml-gen")))
-             ~obj_name:lib.name)
+                      (Path.relative dir (lib_name ^ ".ml-gen")))
+             ~obj_name:lib_name)
     in
     { modules; alias_module; main_module_name }
 end
@@ -221,14 +223,14 @@ module Executables_modules = struct
 end
 
 type modules =
-  { libraries : Library_modules.t String.Map.t
+  { libraries : Library_modules.t Lib_name.Map.t
   ; executables : Executables_modules.t String.Map.t
   ; (* Map from modules to the buildable they are part of *)
     rev_map : Buildable.t Module.Name.Map.t
   }
 
 let empty_modules =
-  { libraries = String.Map.empty
+  { libraries = Lib_name.Map.empty
   ; executables = String.Map.empty
   ; rev_map = Module.Name.Map.empty
   }
@@ -259,12 +261,12 @@ let text_files t = t.text_files
 
 let modules_of_library t ~name =
   let map = (Lazy.force t.modules).libraries in
-  match String.Map.find map name with
+  match Lib_name.Map.find map name with
   | Some m -> m
   | None ->
     Exn.code_error "Dir_contents.modules_of_library"
-      [ "name", Sexp.To_sexp.string name
-      ; "available", Sexp.To_sexp.(list string) (String.Map.keys map)
+      [ "name", Lib_name.to_sexp name
+      ; "available", Sexp.To_sexp.(list Lib_name.to_sexp) (Lib_name.Map.keys map)
       ]
 
 let modules_of_executables t ~first_exe =
@@ -383,14 +385,14 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
   in
   let libraries =
     match
-      String.Map.of_list_map libs ~f:(fun (lib, m) -> Library.best_name lib, m)
+      Lib_name.Map.of_list_map libs ~f:(fun (lib, m) -> Library.best_name lib, m)
     with
     | Ok x -> x
     | Error (name, _, (lib2, _)) ->
       Errors.fail lib2.buildable.loc
-        "Library %S appears for the second time \
+        "Library %a appears for the second time \
          in this directory"
-        name
+        Lib_name.pp_quoted name
   in
   let executables =
     match

src/dir_contents.mli

@@ -29,7 +29,7 @@ module Executables_modules : sig
 end
 
 (** Modules attached to a library. [name] is the library best name. *)
-val modules_of_library : t -> name:string -> Library_modules.t
+val modules_of_library : t -> name:Lib_name.t -> Library_modules.t
 
 (** Modules attached to a set of executables. *)
 val modules_of_executables : t -> first_exe:string -> Executables_modules.t