diff --git a/bin/main.ml b/bin/main.ml index 3c6c6e74..51e8acea 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -583,22 +583,25 @@ let installed_libraries = let findlib = ctx.findlib in if na then begin let pkgs = Findlib.all_unavailable_packages findlib in - let longest = String.longest_map pkgs ~f:fst in + let longest = + String.longest_map pkgs ~f:(fun (n, _) -> Lib_name.to_string n) in let ppf = Format.std_formatter in List.iter pkgs ~f:(fun (n, r) -> - Format.fprintf ppf "%-*s -> %a@\n" longest n + Format.fprintf ppf "%-*s -> %a@\n" longest (Lib_name.to_string n) Findlib.Unavailable_reason.pp r); Format.pp_print_flush ppf (); 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 +832,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 +879,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 +910,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 diff --git a/src/artifacts.ml b/src/artifacts.ml index ede53bb1..22df2568 100644 --- a/src/artifacts.ml +++ b/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) diff --git a/src/artifacts.mli b/src/artifacts.mli index 2e551ab0..70ea75ff 100644 --- a/src/artifacts.mli +++ b/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 diff --git a/src/build_interpret.ml b/src/build_interpret.ml index 56dbcd39..6601e146 100644 --- a/src/build_interpret.ml +++ b/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 -> diff --git a/src/build_system.ml b/src/build_system.ml index c2a6a300..f6158551 100644 --- a/src/build_system.ml +++ b/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 diff --git a/src/config.ml b/src/config.ml index 057fb962..cab39c77 100644 --- a/src/config.ml +++ b/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 diff --git a/src/config.mli b/src/config.mli index 67392f73..b93faf2d 100644 --- a/src/config.mli +++ b/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 diff --git a/src/dep_path.ml b/src/dep_path.ml index 8fb0abb7..7c3284b6 100644 --- a/src/dep_path.ml +++ b/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 diff --git a/src/dep_path.mli b/src/dep_path.mli index 8483946f..15a088b6 100644 --- a/src/dep_path.mli +++ b/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 diff --git a/src/dir_contents.ml b/src/dir_contents.ml index f41bb265..bf565198 100644 --- a/src/dir_contents.ml +++ b/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 diff --git a/src/dir_contents.mli b/src/dir_contents.mli index 4d28c9ec..09833d17 100644 --- a/src/dir_contents.mli +++ b/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 diff --git a/src/dune_file.ml b/src/dune_file.ml index 2944d8b7..d1018adc 100644 --- a/src/dune_file.ml +++ b/src/dune_file.ml @@ -38,82 +38,6 @@ let module_name = let module_names = list module_name >>| String.Set.of_list -module Lib_name : sig - type t - - type result = - | Ok of t - | Warn of t - | Invalid - - val invalid_message : string - - val to_string : t -> string - - val of_string : string -> result - - val validate : (Loc.t * result) -> wrapped:bool -> t - - val dparse : (Loc.t * result) Dsexp.Of_sexp.t -end = struct - type t = string - - let invalid_message = - "invalid library name.\n\ - Hint: library names must be non-empty and composed only of \ - the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'" - - let wrapped_message = - sprintf - "%s.\n\ - This is temporary allowed for libraries with (wrapped false).\ - \nIt will not be supported in the future. \ - Please choose a valid name field." - invalid_message - - type result = - | Ok of t - | Warn of t - | Invalid - - let validate (loc, res) ~wrapped = - match res, wrapped with - | Ok s, _ -> s - | Warn _, true -> Errors.fail loc "%s" wrapped_message - | Warn s, false -> Errors.warn loc "%s" wrapped_message; s - | Invalid, _ -> Errors.fail loc "%s" invalid_message - - let valid_char = function - | 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true - | _ -> false - - let to_string s = s - - let of_string name = - match name with - | "" -> Invalid - | s -> - if s.[0] = '.' then - Invalid - else - let len = String.length s in - let rec loop warn i = - if i = len - 1 then - if warn then Warn s else Ok s - else - let c = String.unsafe_get s i in - if valid_char c then - loop warn (i + 1) - else if c = '.' then - loop true (i + 1) - else - Invalid - in - loop false 0 - - let dparse = plain_string (fun ~loc s -> (loc, of_string s)) -end - let file = plain_string (fun ~loc s -> match s with @@ -230,20 +154,23 @@ module Pkg = struct end module Pp : sig - type t = private string - val of_string : string -> t + type t = private Lib_name.t + val of_string : loc:Loc.t option -> string -> t val to_string : t -> string val compare : t -> t -> Ordering.t + val to_lib_name : t -> Lib_name.t end = struct - type t = string + type t = Lib_name.t - let of_string s = + let to_lib_name s = s + + let of_string ~loc s = assert (not (String.is_prefix s ~prefix:"-")); - s + Lib_name.of_string_exn ~loc s - let to_string t = t + let to_string = Lib_name.to_string - let compare = String.compare + let compare = Lib_name.compare end module Pps_and_flags = struct @@ -252,7 +179,7 @@ module Pps_and_flags = struct if String.is_prefix s ~prefix:"-" then Right [s] else - Left (loc, Pp.of_string s) + Left (loc, Pp.of_string ~loc:(Some loc) s) let item = peek_exn >>= function @@ -282,7 +209,7 @@ module Pps_and_flags = struct if String.is_prefix s ~prefix:"-" then Right s else - Left (loc, Pp.of_string s)) + Left (loc, Pp.of_string ~loc:(Some loc) s)) in (pps, more_flags @ Option.value flags ~default:[]) end @@ -591,8 +518,8 @@ end module Lib_dep = struct type choice = - { required : String.Set.t - ; forbidden : String.Set.t + { required : Lib_name.Set.t + ; forbidden : Lib_name.Set.t ; file : string } @@ -603,7 +530,7 @@ module Lib_dep = struct } type t = - | Direct of (Loc.t * string) + | Direct of (Loc.t * Lib_name.t) | Select of select let choice = @@ -611,12 +538,14 @@ module Lib_dep = struct let%map loc = loc and preds, file = until_keyword "->" - ~before:(let%map s = string in + ~before:(let%map s = string + and loc = loc in let len = String.length s in if len > 0 && s.[0] = '!' then - Right (String.drop s 1) + Right (Lib_name.of_string_exn ~loc:(Some loc) + (String.drop s 1)) else - Left s) + Left (Lib_name.of_string_exn ~loc:(Some loc) s)) ~after:file in match file with @@ -625,21 +554,21 @@ module Lib_dep = struct | Some file -> let rec loop required forbidden = function | [] -> - let common = String.Set.inter required forbidden in - Option.iter (String.Set.choose common) ~f:(fun name -> + let common = Lib_name.Set.inter required forbidden in + Option.iter (Lib_name.Set.choose common) ~f:(fun name -> of_sexp_errorf loc "library %S is both required and forbidden in this clause" - name); + (Lib_name.to_string name)); { required ; forbidden ; file } | Left s :: l -> - loop (String.Set.add required s) forbidden l + loop (Lib_name.Set.add required s) forbidden l | Right s :: l -> - loop required (String.Set.add forbidden s) l + loop required (Lib_name.Set.add forbidden s) l in - loop String.Set.empty String.Set.empty preds) + loop Lib_name.Set.empty Lib_name.Set.empty preds) let dparse = if_list @@ -651,18 +580,20 @@ module Lib_dep = struct and () = keyword "from" and choices = repeat choice in Select { result_fn; choices; loc })) - ~else_:(plain_string (fun ~loc s -> Direct (loc, s))) + ~else_:( + let%map (loc, name) = located Lib_name.dparse in + Direct (loc, name)) let to_lib_names = function | Direct (_, s) -> [s] | Select s -> - List.fold_left s.choices ~init:String.Set.empty ~f:(fun acc x -> - String.Set.union acc (String.Set.union x.required x.forbidden)) - |> String.Set.to_list + List.fold_left s.choices ~init:Lib_name.Set.empty ~f:(fun acc x -> + Lib_name.Set.union acc (Lib_name.Set.union x.required x.forbidden)) + |> Lib_name.Set.to_list let direct x = Direct x - let of_pp (loc, pp) = Direct (loc, Pp.to_string pp) + let of_pp (loc, pp) = Direct (loc, Pp.to_lib_name pp) end module Lib_deps = struct @@ -678,36 +609,37 @@ module Lib_deps = struct and t = repeat Lib_dep.dparse in let add kind name acc = - match String.Map.find acc name with - | None -> String.Map.add acc name kind + match Lib_name.Map.find acc name with + | None -> Lib_name.Map.add acc name kind | Some kind' -> match kind, kind' with | Required, Required -> - of_sexp_errorf loc "library %S is present twice" name + of_sexp_errorf loc "library %S is present twice" + (Lib_name.to_string name) | (Optional|Forbidden), (Optional|Forbidden) -> acc | Optional, Required | Required, Optional -> of_sexp_errorf loc "library %S is present both as an optional \ and required dependency" - name + (Lib_name.to_string name) | Forbidden, Required | Required, Forbidden -> of_sexp_errorf loc "library %S is present both as a forbidden \ and required dependency" - name + (Lib_name.to_string name) in ignore ( - List.fold_left t ~init:String.Map.empty ~f:(fun acc x -> + List.fold_left t ~init:Lib_name.Map.empty ~f:(fun acc x -> match x with | Lib_dep.Direct (_, s) -> add Required s acc | Select { choices; _ } -> List.fold_left choices ~init:acc ~f:(fun acc c -> let acc = - String.Set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) + Lib_name.Set.fold c.Lib_dep.required ~init:acc ~f:(add Optional) in - String.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) - : kind String.Map.t); + Lib_name.Set.fold c.forbidden ~init:acc ~f:(add Forbidden))) + : kind Lib_name.Map.t); t let dparse = parens_removed_in_dune dparse @@ -721,9 +653,9 @@ module Lib_deps = struct | Lib_dep.Direct (_, s) -> [(s, kind)] | Select { choices; _ } -> List.concat_map choices ~f:(fun c -> - String.Set.to_list c.Lib_dep.required + Lib_name.Set.to_list c.Lib_dep.required |> List.map ~f:(fun d -> (d, Lib_deps_info.Kind.Optional)))) - |> String.Map.of_list_reduce ~f:Lib_deps_info.Kind.merge + |> Lib_name.Map.of_list_reduce ~f:Lib_deps_info.Kind.merge end module Buildable = struct @@ -786,7 +718,7 @@ end module Public_lib = struct type t = - { name : Loc.t * string + { name : Loc.t * Lib_name.t ; package : Package.t ; sub_dir : string option } @@ -796,25 +728,23 @@ module Public_lib = struct let public_name_field = map_validate (let%map project = Dune_project.get_exn () - and loc_name = field_o "public_name" (located string) in + and loc_name = field_o "public_name" (located Lib_name.dparse) in (project, loc_name)) ~f:(fun (project, loc_name) -> match loc_name with | None -> Ok None | Some ((_, s) as loc_name) -> - match String.split s ~on:'.' with - | [] -> assert false - | pkg :: rest -> - match Pkg.resolve project (Package.Name.of_string pkg) with - | Ok pkg -> - Ok (Some - { package = pkg - ; sub_dir = - if rest = [] then None else - Some (String.concat rest ~sep:"/") - ; name = loc_name - }) - | Error _ as e -> e) + let (pkg, rest) = Lib_name.split s in + match Pkg.resolve project pkg with + | Ok pkg -> + Ok (Some + { package = pkg + ; sub_dir = + if rest = [] then None else + Some (String.concat rest ~sep:"/") + ; name = loc_name + }) + | Error _ as e -> e) end module Sub_system_info = struct @@ -919,11 +849,11 @@ module Library = struct end type t = - { name : string + { name : Lib_name.Local.t ; public : Public_lib.t option ; synopsis : string option ; install_c_headers : string list - ; ppx_runtime_libraries : (Loc.t * string) list + ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list ; modes : Mode_conf.Set.t ; kind : Kind.t ; c_flags : Ordered_set_lang.Unexpanded.t @@ -933,7 +863,7 @@ module Library = struct ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t ; self_build_stubs_archive : string option - ; virtual_deps : (Loc.t * string) list + ; virtual_deps : (Loc.t * Lib_name.t) list ; wrapped : bool ; optional : bool ; buildable : Buildable.t @@ -948,13 +878,13 @@ module Library = struct record (let%map buildable = Buildable.dparse and loc = loc - and name = field_o "name" Lib_name.dparse + and name = field_o "name" Lib_name.Local.dparse_loc and public = Public_lib.public_name_field and synopsis = field_o "synopsis" string and install_c_headers = field "install_c_headers" (list string) ~default:[] and ppx_runtime_libraries = - field "ppx_runtime_libraries" (list (located string)) ~default:[] + field "ppx_runtime_libraries" (list (located Lib_name.dparse)) ~default:[] and c_flags = field_oslu "c_flags" and cxx_flags = field_oslu "cxx_flags" and c_names = field "c_names" (list c_name) ~default:[] @@ -962,7 +892,7 @@ module Library = struct and library_flags = field_oslu "library_flags" and c_library_flags = field_oslu "c_library_flags" and virtual_deps = - field "virtual_deps" (list (located string)) ~default:[] + field "virtual_deps" (list (located Lib_name.dparse)) ~default:[] and modes = field "modes" Mode_conf.Set.dparse ~default:Mode_conf.Set.default and kind = field "kind" Kind.dparse ~default:Kind.Normal and wrapped = field "wrapped" bool ~default:true @@ -981,19 +911,18 @@ module Library = struct let open Syntax.Version.Infix in match name, public with | Some n, _ -> - Lib_name.validate n ~wrapped - |> Lib_name.to_string + Lib_name.Local.validate n ~wrapped | None, Some { name = (loc, name) ; _ } -> if dune_version >= (1, 1) then - match Lib_name.of_string name with - | Ok m -> Lib_name.to_string m + match Lib_name.to_local name with + | Ok m -> m | Warn _ | Invalid -> of_sexp_errorf loc "%s.\n\ Public library names don't have this restriction. \ You can either change this public name to be a valid library \ name or add a \"name\" field with a valid library name." - Lib_name.invalid_message + Lib_name.Local.invalid_message else of_sexp_error loc "name field cannot be omitted before version \ 1.1 of the dune language" @@ -1036,17 +965,19 @@ module Library = struct | _ -> true let stubs_archive t ~dir ~ext_lib = - Path.relative dir (sprintf "lib%s_stubs%s" t.name ext_lib) + Path.relative dir (sprintf "lib%s_stubs%s" + (Lib_name.Local.to_string t.name) ext_lib) let dll t ~dir ~ext_dll = - Path.relative dir (sprintf "dll%s_stubs%s" t.name ext_dll) + Path.relative dir (sprintf "dll%s_stubs%s" + (Lib_name.Local.to_string t.name) ext_dll) let archive t ~dir ~ext = - Path.relative dir (t.name ^ ext) + Path.relative dir (Lib_name.Local.to_string t.name ^ ext) let best_name t = match t.public with - | None -> t.name + | None -> Lib_name.of_local t.name | Some p -> snd p.name end diff --git a/src/dune_file.mli b/src/dune_file.mli index e14ebc52..c4172a94 100644 --- a/src/dune_file.mli +++ b/src/dune_file.mli @@ -5,9 +5,11 @@ open Import (** Ppx preprocessors *) module Pp : sig - type t = private string - val of_string : string -> t + type t = private Lib_name.t + val of_string : loc:Loc.t option -> string -> t val to_string : t -> string + + val to_lib_name : t -> Lib_name.t val compare : t -> t -> Ordering.t end @@ -58,8 +60,8 @@ end module Lib_dep : sig type choice = - { required : String.Set.t - ; forbidden : String.Set.t + { required : Lib_name.Set.t + ; forbidden : Lib_name.Set.t ; file : string } @@ -70,11 +72,11 @@ module Lib_dep : sig } type t = - | Direct of (Loc.t * string) + | Direct of (Loc.t * Lib_name.t) | Select of select - val to_lib_names : t -> string list - val direct : Loc.t * string -> t + val to_lib_names : t -> Lib_name.t list + val direct : Loc.t * Lib_name.t -> t val of_pp : Loc.t * Pp.t -> t end @@ -146,13 +148,13 @@ end module Public_lib : sig type t = - { name : Loc.t * string (** Full public name *) + { name : Loc.t * Lib_name.t (** Full public name *) ; package : Package.t (** Package it is part of *) ; sub_dir : string option (** Subdirectory inside the installation directory *) } - val name : t -> string + val name : t -> Lib_name.t end module Sub_system_info : sig @@ -215,11 +217,11 @@ module Library : sig end type t = - { name : string + { name : Lib_name.Local.t ; public : Public_lib.t option ; synopsis : string option ; install_c_headers : string list - ; ppx_runtime_libraries : (Loc.t * string) list + ; ppx_runtime_libraries : (Loc.t * Lib_name.t) list ; modes : Mode_conf.Set.t ; kind : Kind.t ; c_flags : Ordered_set_lang.Unexpanded.t @@ -229,7 +231,7 @@ module Library : sig ; library_flags : Ordered_set_lang.Unexpanded.t ; c_library_flags : Ordered_set_lang.Unexpanded.t ; self_build_stubs_archive : string option - ; virtual_deps : (Loc.t * string) list + ; virtual_deps : (Loc.t * Lib_name.t) list ; wrapped : bool ; optional : bool ; buildable : Buildable.t @@ -244,7 +246,7 @@ module Library : sig val stubs_archive : t -> dir:Path.t -> ext_lib:string -> Path.t val dll : t -> dir:Path.t -> ext_dll:string -> Path.t val archive : t -> dir:Path.t -> ext:string -> Path.t - val best_name : t -> string + val best_name : t -> Lib_name.t end module Install_conf : sig diff --git a/src/findlib.ml b/src/findlib.ml index 027adaa3..6f2cca3b 100644 --- a/src/findlib.ml +++ b/src/findlib.ml @@ -1,6 +1,8 @@ open! Stdune open Import +module Opam_package = Package + module P = Variant module Ps = Variant.Set @@ -122,7 +124,7 @@ module Config = struct if not (Path.exists conf_file) then die "@{Error@}: ocamlfind toolchain %s isn't defined in %a \ (context: %s)" toolchain Path.pp path context; - let vars = (Meta.load ~name:"" conf_file).vars in + let vars = (Meta.load ~name:None conf_file).vars in { vars = String.Map.map vars ~f:Rules.of_meta_rules ; preds = Ps.make [toolchain] } @@ -139,7 +141,7 @@ end module Package = struct type t = { meta_file : Path.t - ; name : string + ; name : Lib_name.t ; dir : Path.t ; vars : Vars.t } @@ -160,8 +162,12 @@ module Package = struct let version t = Vars.get t.vars "version" Ps.empty let description t = Vars.get t.vars "description" Ps.empty let jsoo_runtime t = get_paths t "jsoo_runtime" Ps.empty - let requires t = Vars.get_words t.vars "requires" preds - let ppx_runtime_deps t = Vars.get_words t.vars "ppx_runtime_deps" preds + let requires t = + Vars.get_words t.vars "requires" preds + |> List.map ~f:(Lib_name.of_string_exn ~loc:None) + let ppx_runtime_deps t = + Vars.get_words t.vars "ppx_runtime_deps" preds + |> List.map ~f:(Lib_name.of_string_exn ~loc:None) let archives t = make_archives t "archive" preds let plugins t = @@ -170,7 +176,8 @@ module Package = struct (make_archives t "plugin" preds) let dune_file t = - let fn = Path.relative t.dir (sprintf "%s.dune" t.name) in + let fn = Path.relative t.dir + (sprintf "%s.dune" (Lib_name.to_string t.name)) in Option.some_if (Path.exists fn) fn end @@ -191,22 +198,20 @@ end type t = { stdlib_dir : Path.t ; path : Path.t list - ; builtins : Meta.Simplified.t String.Map.t - ; packages : (string, (Package.t, Unavailable_reason.t) result) Hashtbl.t + ; builtins : Meta.Simplified.t Lib_name.Map.t + ; packages : (Lib_name.t, (Package.t, Unavailable_reason.t) result) Hashtbl.t } let path t = t.path -let root_package_name s = - match String.index s '.' with - | None -> s - | Some i -> String.take s i - let dummy_package t ~name = let dir = match t.path with | [] -> t.stdlib_dir - | dir :: _ -> Path.relative dir (root_package_name name) + | dir :: _ -> + Lib_name.package_name name + |> Opam_package.Name.to_string + |> Path.relative dir in { Package. meta_file = Path.relative dir "META" @@ -244,7 +249,7 @@ let parse_package t ~meta_file ~name ~parent_dir ~vars = List.for_all exists_if ~f:(fun fn -> Path.exists (Path.relative dir fn)) | [] -> - if not (String.Map.mem t.builtins (root_package_name name)) then + if not (Lib_name.Map.mem t.builtins (Lib_name.root_lib name)) then true else (* The META files for installed packages are sometimes broken, @@ -277,34 +282,38 @@ let parse_and_acknowledge_meta t ~dir ~meta_file (meta : Meta.Simplified.t) = in Hashtbl.add t.packages full_name res; List.iter meta.subs ~f:(fun (meta : Meta.Simplified.t) -> - loop ~dir ~full_name:(sprintf "%s.%s" full_name meta.name) meta) + let full_name = + match meta.name with + | None -> full_name + | Some name -> Lib_name.nest full_name name in + loop ~dir ~full_name meta) in - loop ~dir ~full_name:meta.name meta + loop ~dir ~full_name:(Option.value_exn meta.name) meta (* Search for a /META file in the findlib search path, parse it and add its contents to [t.packages] *) let find_and_acknowledge_meta t ~fq_name = - let root_name = root_package_name fq_name in + let root_name = Lib_name.root_lib fq_name in let rec loop dirs : (Path.t * Path.t * Meta.Simplified.t) option = match dirs with | dir :: dirs -> - let sub_dir = Path.relative dir root_name in + let sub_dir = Path.relative dir (Lib_name.to_string root_name) in let fn = Path.relative sub_dir "META" in if Path.exists fn then Some (sub_dir, fn, - Meta.load ~name:root_name fn) + Meta.load ~name:(Some root_name) fn) else (* Alternative layout *) - let fn = Path.relative dir ("META." ^ root_name) in + let fn = Path.relative dir ("META." ^ (Lib_name.to_string root_name)) in if Path.exists fn then Some (dir, fn, - Meta.load fn ~name:root_name) + Meta.load fn ~name:(Some root_name)) else loop dirs | [] -> - String.Map.find t.builtins root_name + Lib_name.Map.find t.builtins root_name |> Option.map ~f:(fun meta -> (t.stdlib_dir, Path.of_string "", meta)) in @@ -336,15 +345,18 @@ let root_packages t = List.concat_map t.path ~f:(fun dir -> Sys.readdir (Path.to_string dir) |> Array.to_list - |> List.filter ~f:(fun name -> - Path.exists (Path.relative dir (name ^ "/META")))) - |> String.Set.of_list + |> List.filter_map ~f:(fun name -> + if Path.exists (Path.relative dir (name ^ "/META")) then + Some (Lib_name.of_string_exn ~loc:None name) + else + None)) + |> Lib_name.Set.of_list in - String.Set.union pkgs - (String.Set.of_list (String.Map.keys t.builtins)) + Lib_name.Set.union pkgs + (Lib_name.Set.of_list (Lib_name.Map.keys t.builtins)) let load_all_packages t = - String.Set.iter (root_packages t) ~f:(fun pkg -> + Lib_name.Set.iter (root_packages t) ~f:(fun pkg -> find_and_acknowledge_meta t ~fq_name:pkg) let all_packages t = @@ -353,7 +365,7 @@ let all_packages t = match x with | Ok p -> p :: acc | Error _ -> acc) - |> List.sort ~compare:(fun (a : Package.t) b -> String.compare a.name b.name) + |> List.sort ~compare:(fun (a : Package.t) b -> Lib_name.compare a.name b.name) let create ~stdlib_dir ~path = { stdlib_dir @@ -368,4 +380,4 @@ let all_unavailable_packages t = match x with | Ok _ -> acc | Error e -> ((name, e) :: acc)) - |> List.sort ~compare:(fun (a, _) (b, _) -> String.compare a b) + |> List.sort ~compare:(fun (a, _) (b, _) -> Lib_name.compare a b) diff --git a/src/findlib.mli b/src/findlib.mli index c098469b..e1eb110d 100644 --- a/src/findlib.mli +++ b/src/findlib.mli @@ -14,23 +14,20 @@ val create (** The search path for this DB *) val path : t -> Path.t list -(** [root_package_name "foo.*"] is "foo" *) -val root_package_name : string -> string - module Package : sig (** Representation of a findlib package *) type t val meta_file : t -> Path.t - val name : t -> string + val name : t -> Lib_name.t val dir : t -> Path.t val version : t -> string option val description : t -> string option val archives : t -> Path.t list Mode.Dict.t val plugins : t -> Path.t list Mode.Dict.t val jsoo_runtime : t -> Path.t list - val requires : t -> string list - val ppx_runtime_deps : t -> string list + val requires : t -> Lib_name.t list + val ppx_runtime_deps : t -> Lib_name.t list val dune_file : t -> Path.t option end @@ -46,18 +43,18 @@ module Unavailable_reason : sig end (** Lookup a package in the given database *) -val find : t -> string -> (Package.t, Unavailable_reason.t) result +val find : t -> Lib_name.t -> (Package.t, Unavailable_reason.t) result -val available : t -> string -> bool +val available : t -> Lib_name.t -> bool (** List all the packages available in this Database *) val all_packages : t -> Package.t list (** List all the packages that are not available in this database *) -val all_unavailable_packages : t -> (string * Unavailable_reason.t) list +val all_unavailable_packages : t -> (Lib_name.t * Unavailable_reason.t) list (** A dummy package. This is used to implement [external-lib-deps] *) -val dummy_package : t -> name:string -> Package.t +val dummy_package : t -> name:Lib_name.t -> Package.t module Config : sig type t diff --git a/src/gen_meta.ml b/src/gen_meta.ml index 31e631b5..a054203b 100644 --- a/src/gen_meta.ml +++ b/src/gen_meta.ml @@ -8,6 +8,7 @@ module Pub_name = struct | Id of string let parse s = + let s = Lib_name.to_string s in match String.split s ~on:'.' with | [] -> assert false | x :: l -> @@ -32,7 +33,9 @@ module Pub_name = struct let to_string t = String.concat ~sep:"." (to_list t) end -let string_of_deps deps = String.Set.to_list deps |> String.concat ~sep:" " +let string_of_deps deps = + Lib_name.Set.to_string_list deps + |> String.concat ~sep:" " let rule var predicates action value = Rule { var; predicates; action; value } @@ -82,7 +85,7 @@ let gen_lib pub_name lib ~version = ; requires ~preds lib_deps ] ; archives ~preds lib - ; if String.Set.is_empty ppx_rt_deps then + ; if Lib_name.Set.is_empty ppx_rt_deps then [] else [ Comment "This is what dune uses to find out the runtime \ @@ -163,7 +166,7 @@ let gen ~package ~version libs = entries = directory name :: pkg.entries }) in - { name + { name = Some (Lib_name.of_string_exn ~loc:None name) ; entries = entries @ subs } in diff --git a/src/inline_tests.ml b/src/inline_tests.ml index 0703011a..4788f123 100644 --- a/src/inline_tests.ml +++ b/src/inline_tests.ml @@ -13,10 +13,10 @@ module Backend = struct type t = { loc : Loc.t - ; runner_libraries : (Loc.t * string) list + ; runner_libraries : (Loc.t * Lib_name.t) list ; flags : Ordered_set_lang.Unexpanded.t ; generate_runner : (Loc.t * Action.Unexpanded.t) option - ; extends : (Loc.t * string) list + ; extends : (Loc.t * Lib_name.t) list } type Dune_file.Sub_system_info.t += T of t @@ -36,10 +36,10 @@ module Backend = struct let parse = record (let%map loc = loc - and runner_libraries = field "runner_libraries" (list (located string)) ~default:[] + and runner_libraries = field "runner_libraries" (list (located Lib_name.dparse)) ~default:[] and flags = Ordered_set_lang.Unexpanded.field "flags" and generate_runner = field_o "generate_runner" (located Action.Unexpanded.dparse) - and extends = field "extends" (list (located string)) ~default:[] + and extends = field "extends" (list (located Lib_name.dparse)) ~default:[] in { loc ; runner_libraries @@ -75,15 +75,16 @@ module Backend = struct resolve x >>= fun lib -> match get ~loc lib with | None -> - Error (Errors.exnf loc "%S is not an %s" name + Error (Errors.exnf loc "%S is not an %s" + (Lib_name.to_string name) (desc ~plural:false)) | Some t -> Ok t)) } let dgen t = let open Dsexp.To_sexp in - let lib x = string (Lib.name x) in - let f x = string (Lib.name x.lib) in + let lib x = Lib_name.dgen (Lib.name x) in + let f x = Lib_name.dgen (Lib.name x.lib) in ((1, 0), record_fields [ field "runner_libraries" (list lib) @@ -109,8 +110,8 @@ include Sub_system.Register_end_point( { loc : Loc.t ; deps : Dep_conf.t list ; flags : Ordered_set_lang.Unexpanded.t - ; backend : (Loc.t * string) option - ; libraries : (Loc.t * string) list + ; backend : (Loc.t * Lib_name.t) option + ; libraries : (Loc.t * Lib_name.t) list } type Dune_file.Sub_system_info.t += T of t @@ -138,8 +139,8 @@ include Sub_system.Register_end_point( (let%map loc = loc and deps = field "deps" (list Dep_conf.dparse) ~default:[] and flags = Ordered_set_lang.Unexpanded.field "flags" - and backend = field_o "backend" (located string) - and libraries = field "libraries" (list (located string)) ~default:[] + and backend = field_o "backend" (located Lib_name.dparse) + and libraries = field "libraries" (list (located Lib_name.dparse)) ~default:[] in { loc ; deps @@ -161,7 +162,8 @@ include Sub_system.Register_end_point( in let inline_test_dir = - Path.relative dir (sprintf ".%s.inline-tests" lib.name) + Path.relative dir (sprintf ".%s.inline-tests" + (Lib_name.Local.to_string lib.name)) in let name = "run" in @@ -178,7 +180,7 @@ include Sub_system.Register_end_point( let bindings = Pform.Map.singleton "library-name" - (Values [String lib.name]) + (Values [String (Lib_name.Local.to_string lib.name)]) in let runner_libs = @@ -186,7 +188,7 @@ include Sub_system.Register_end_point( Result.List.concat_map backends ~f:(fun (backend : Backend.t) -> backend.runner_libraries) >>= fun libs -> - Lib.DB.find_many (Scope.libs scope) [lib.name] + Lib.DB.find_many (Scope.libs scope) [Dune_file.Library.best_name lib] >>= fun lib -> Result.List.all (List.map info.libraries diff --git a/src/install_rules.ml b/src/install_rules.ml index bc2c4a1c..28d6be20 100644 --- a/src/install_rules.ml +++ b/src/install_rules.ml @@ -16,7 +16,7 @@ module Gen(P : Params) = struct let ctx = Super_context.context sctx let lib_dune_file ~dir ~name = - Path.relative dir (name ^ ".dune") + Path.relative dir ((Lib_name.to_string name) ^ ".dune") let gen_lib_dune_file lib = SC.add_rule sctx @@ -115,7 +115,7 @@ module Gen(P : Params) = struct >>> Build.write_file_dyn meta))) - let lib_install_files ~dir_contents ~dir ~sub_dir ~name ~scope ~dir_kind + let lib_install_files ~dir_contents ~dir ~sub_dir ~(name : Lib_name.t) ~scope ~dir_kind (lib : Library.t) = let obj_dir = Utils.library_object_directory ~dir lib.name in let make_entry section ?dst fn = @@ -195,13 +195,16 @@ module Gen(P : Params) = struct List.concat_map lib.buildable.libraries ~f:Lib_dep.to_lib_names in match - List.filter deps ~f:(function + List.filter deps ~f:(fun lib_name -> + match Lib_name.to_string lib_name with | "ppx_driver" | "ppxlib" | "ppx_type_conv" -> true | _ -> false) with | [] -> None | l -> - match Scope.name scope, List.mem ~set:l "ppxlib" with + match Scope.name scope + , List.mem ~set:l (Lib_name.of_string_exn ~loc:None "ppxlib") + with | Named "ppxlib", _ | _, true -> Some "ppxlib.runner" | _ -> diff --git a/src/js_of_ocaml_rules.ml b/src/js_of_ocaml_rules.ml index d2f9c611..6e70e1fe 100644 --- a/src/js_of_ocaml_rules.ml +++ b/src/js_of_ocaml_rules.ml @@ -20,11 +20,11 @@ let in_build_dir ~ctx = let init = Path.relative ctx.Context.build_dir ".js" in List.fold_left ~init ~f:Path.relative -let runtime_file ~sctx fname = +let runtime_file ~sctx file = match Artifacts.file_of_lib (SC.artifacts sctx) ~loc:Loc.none - ~lib:"js_of_ocaml-compiler" ~file:fname + ~lib:(Lib_name.of_string_exn ~loc:None "js_of_ocaml-compiler") ~file with | Error _ -> Arg_spec.Dyn (fun _ -> @@ -89,7 +89,10 @@ let link_rule cc ~runtime ~target = ) else ( let lib_name = Lib.name lib in List.map ~f:(fun js -> - in_build_dir ~ctx [lib_name ; Path.basename js]) jsoo_archives + in_build_dir ~ctx + [ Lib_name.to_string lib_name + ; Path.basename js + ]) jsoo_archives ) ) in @@ -138,6 +141,7 @@ let setup_separate_compilation_rules sctx components = match components with | [] | _ :: _ :: _ -> () | [pkg] -> + let pkg = Lib_name.of_string_exn ~loc:None pkg in let ctx = SC.context sctx in match Lib.DB.find (SC.installed_libs sctx) pkg with | Error _ -> () @@ -146,17 +150,18 @@ let setup_separate_compilation_rules sctx components = let archives = (* Special case for the stdlib because it is not referenced in the META *) - match Lib.name pkg with + match Lib_name.to_string (Lib.name pkg) with | "stdlib" -> Path.relative ctx.stdlib_dir "stdlib.cma" :: archives | _ -> archives in List.iter archives ~f:(fun fn -> let name = Path.basename fn in let src = Path.relative (Lib.src_dir pkg) name in + let lib_name = Lib_name.to_string (Lib.name pkg) in let target = - in_build_dir ~ctx [ Lib.name pkg; sprintf "%s.js" name] + in_build_dir ~ctx [lib_name ; sprintf "%s.js" name] in - let dir = in_build_dir ~ctx [ Lib.name pkg ] in + let dir = in_build_dir ~ctx [lib_name] in let spec = Arg_spec.Dep src in SC.add_rule sctx (Build.return (standard sctx) diff --git a/src/lib.ml b/src/lib.ml index 89ebaa00..8c3987c6 100644 --- a/src/lib.ml +++ b/src/lib.ml @@ -28,7 +28,7 @@ end module Info = struct module Deps = struct type t = - | Simple of (Loc.t * string) list + | Simple of (Loc.t * Lib_name.t) list | Complex of Dune_file.Lib_dep.t list let of_lib_deps deps = @@ -60,10 +60,10 @@ module Info = struct ; foreign_archives : Path.t list Mode.Dict.t ; jsoo_runtime : Path.t list ; requires : Deps.t - ; ppx_runtime_deps : (Loc.t * string) list + ; ppx_runtime_deps : (Loc.t * Lib_name.t) list ; pps : (Loc.t * Dune_file.Pp.t) list ; optional : bool - ; virtual_deps : (Loc.t * string) list + ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option ; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t } @@ -74,7 +74,8 @@ module Info = struct ~f:(fun acc s -> Dune_file.Lib_dep.Direct s :: acc) let of_library_stanza ~dir ~ext_lib (conf : Dune_file.Library.t) = - let archive_file ext = Path.relative dir (conf.name ^ ext) in + let archive_file ext = + Path.relative dir (Lib_name.Local.to_string conf.name ^ ext) in let archive_files ~f_ext = Mode.Dict.of_func (fun ~mode -> [archive_file (f_ext mode)]) in @@ -96,7 +97,9 @@ module Info = struct in { Mode.Dict. byte = stubs - ; native = Path.relative dir (conf.name ^ ext_lib) :: stubs + ; native = + Path.relative dir (Lib_name.Local.to_string conf.name ^ ext_lib) + :: stubs } in { loc = conf.buildable.loc @@ -159,7 +162,7 @@ module Error0 = struct module Reason = struct module Hidden = struct type t = - { name : string + { name : Lib_name.t ; path : Path.t ; reason : string } @@ -180,7 +183,7 @@ module Error0 = struct type t = { loc : Loc.t - ; name : string + ; name : Lib_name.t ; reason : Reason.t } end @@ -217,13 +220,13 @@ module Id = struct type t = { unique_id : int ; path : Path.t - ; name : string + ; name : Lib_name.t } end type t = { info : Info.t - ; name : string + ; name : Lib_name.t ; unique_id : int ; requires : t list Or_exn.t ; ppx_runtime_deps : t list Or_exn.t @@ -241,9 +244,9 @@ type t = and db = { parent : db option - ; resolve : string -> resolve_result - ; table : (string, status) Hashtbl.t - ; all : string list Lazy.t + ; resolve : Lib_name.t -> resolve_result + ; table : (Lib_name.t, status) Hashtbl.t + ; all : Lib_name.t list Lazy.t } and status = @@ -255,7 +258,7 @@ and status = and error = | Library_not_available of Error0.Library_not_available.t | No_solution_found_for_select of Error0.No_solution_found_for_select.t - | Dependency_cycle of (Path.t * string) list + | Dependency_cycle of (Path.t * Lib_name.t) list | Conflict of conflict | Overlap of overlap | Private_deps_not_allowed of private_deps_not_allowed @@ -264,7 +267,7 @@ and resolve_result = | Not_found | Found of Info.t | Hidden of Info.t * string - | Redirect of db option * string + | Redirect of db option * Lib_name.t and conflict = { lib1 : t * Dep_path.Entry.t list @@ -310,7 +313,7 @@ module Error = struct type t = error = | Library_not_available of Library_not_available.t | No_solution_found_for_select of No_solution_found_for_select.t - | Dependency_cycle of (Path.t * string) list + | Dependency_cycle of (Path.t * Lib_name.t) list | Conflict of Conflict.t | Overlap of Overlap.t | Private_deps_not_allowed of Private_deps_not_allowed.t @@ -347,9 +350,7 @@ let status t = t.info.status let package t = match t.info.status with - | Installed -> - Some (Findlib.root_package_name t.name - |> Package.Name.of_string) + | Installed -> Some (Lib_name.package_name t.name) | Public p -> Some p.name | Private _ -> None @@ -451,7 +452,7 @@ module Sub_system = struct type t type sub_system += T of t val instantiate - : resolve:(Loc.t * string -> lib Or_exn.t) + : resolve:(Loc.t * Lib_name.t -> lib Or_exn.t) -> get:(loc:Loc.t -> lib -> t option) -> lib -> Info.t @@ -492,7 +493,8 @@ module Sub_system = struct | M.Info.T info -> let get ~loc lib' = if lib.unique_id = lib'.unique_id then - Errors.fail loc "Library %S depends on itself" lib.name + Errors.fail loc "Library %a depends on itself" + Lib_name.pp_quoted lib.name else M.get lib' in @@ -583,7 +585,7 @@ let check_private_deps lib ~loc ~allow_private_deps = Ok lib let already_in_table (info : Info.t) name x = - let dgen = Sexp.To_sexp.(pair Path.to_sexp string) in + let to_sexp = Sexp.To_sexp.(pair Path.to_sexp Lib_name.to_sexp) in let sexp = match x with | St_initializing x -> @@ -600,8 +602,8 @@ let already_in_table (info : Info.t) name x = in Exn.code_error "Lib_db.DB: resolver returned name that's already in the table" - [ "name" , Sexp.To_sexp.string name - ; "returned_lib" , dgen (info.src_dir, name) + [ "name" , Lib_name.to_sexp name + ; "returned_lib" , to_sexp (info.src_dir, name) ; "conflicting_with", sexp ] @@ -635,7 +637,7 @@ let rec instantiate db name (info : Info.t) ~stack ~hidden = let requires = map_error requires in let ppx_runtime_deps = map_error ppx_runtime_deps in let resolve (loc, name) = - resolve_dep db name ~allow_private_deps ~loc ~stack in + resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack in let t = { info ; name @@ -680,12 +682,12 @@ and find_even_when_hidden db name = | St_not_found -> None | St_hidden (t, _) -> Some t -and find_internal db name ~stack : status = +and find_internal db (name : Lib_name.t) ~stack : status = match Hashtbl.find db.table name with | Some x -> x | None -> resolve_name db name ~stack -and resolve_dep db name ~allow_private_deps ~loc ~stack : t Or_exn.t = +and resolve_dep db (name : Lib_name.t) ~allow_private_deps ~loc ~stack : t Or_exn.t = match find_internal db name ~stack with | St_initializing id -> Error (Dep_stack.dependency_cycle stack id) @@ -727,12 +729,12 @@ and resolve_name db name ~stack = | _ -> instantiate db name info ~stack ~hidden:(Some hidden) -and available_internal db name ~stack = +and available_internal db (name : Lib_name.t) ~stack = match resolve_dep db name ~allow_private_deps:true ~loc:Loc.none ~stack with | Ok _ -> true | Error _ -> false -and resolve_simple_deps db names ~allow_private_deps ~stack = +and resolve_simple_deps db (names : ((Loc.t * Lib_name.t) list)) ~allow_private_deps ~stack = Result.List.map names ~f:(fun (loc, name) -> resolve_dep db name ~allow_private_deps ~loc ~stack) @@ -750,13 +752,13 @@ and resolve_complex_deps db deps ~allow_private_deps ~stack = let res, src_fn = match List.find_map choices ~f:(fun { required; forbidden; file } -> - if String.Set.exists forbidden + if Lib_name.Set.exists forbidden ~f:(available_internal db ~stack) then None else match let deps = - String.Set.fold required ~init:[] ~f:(fun x acc -> + Lib_name.Set.fold required ~init:[] ~f:(fun x acc -> (Loc.none, x) :: acc) in resolve_simple_deps ~allow_private_deps db deps ~stack @@ -808,7 +810,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = { (fst first) with stop = (fst last).stop } in let pps = - let pps = (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * string) list) in + let pps = (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * Lib_name.t) list) in resolve_simple_deps db pps ~allow_private_deps:true ~stack >>= fun pps -> closure_with_overlap_checks None pps ~stack @@ -834,11 +836,11 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = (deps, pps, resolved_selects) and closure_with_overlap_checks db ts ~stack = - let visited = ref String.Map.empty in + let visited = ref Lib_name.Map.empty in let res = ref [] in let orig_stack = stack in let rec loop t ~stack = - match String.Map.find !visited t.name with + match Lib_name.Map.find !visited t.name with | Some (t', stack') -> if t.unique_id = t'.unique_id then Ok () @@ -849,7 +851,7 @@ and resolve_user_deps db deps ~allow_private_deps ~pps ~stack = ; lib2 = (t , req_by stack ) })) | None -> - visited := String.Map.add !visited t.name (t, stack); + visited := Lib_name.Map.add !visited t.name (t, stack); (match db with | None -> Ok () | Some db -> @@ -934,7 +936,7 @@ module DB = struct | Not_found | Found of Info.t | Hidden of Info.t * string - | Redirect of db option * string + | Redirect of db option * Lib_name.t end type t = db @@ -952,22 +954,22 @@ module DB = struct let info = Info.of_library_stanza ~dir ~ext_lib conf in match conf.public with | None -> - [(conf.name, Resolve_result.Found info)] + [Dune_file.Library.best_name conf, Resolve_result.Found info] | Some p -> let name = Dune_file.Public_lib.name p in - if name = conf.name then - [(name, Found info)] + if name = Lib_name.of_local conf.name then + [name, Found info] else - [ name , Found info - ; conf.name, Redirect (None, name) + [ name , Found info + ; Lib_name.of_local conf.name, Redirect (None, name) ]) - |> String.Map.of_list + |> Lib_name.Map.of_list |> function | Ok x -> x | Error (name, _, _) -> match List.filter_map stanzas ~f:(fun (_, (conf : Dune_file.Library.t)) -> - if name = conf.name || + if name = Lib_name.of_local conf.name || match conf.public with | None -> false | Some p -> name = Dune_file.Public_lib.name p @@ -976,19 +978,19 @@ module DB = struct with | [] | [_] -> assert false | loc1 :: loc2 :: _ -> - die "Library %S is defined twice:\n\ + die "Library %a is defined twice:\n\ - %s\n\ - %s" - name + Lib_name.pp_quoted name (Loc.to_file_colon_line loc1) (Loc.to_file_colon_line loc2) in create () ?parent ~resolve:(fun name -> - match String.Map.find map name with + match Lib_name.Map.find map name with | None -> Not_found | Some x -> x) - ~all:(fun () -> String.Map.keys map) + ~all:(fun () -> Lib_name.Map.keys map) let create_from_findlib ?(external_lib_deps_mode=false) findlib = create () @@ -1033,7 +1035,7 @@ module DB = struct match find_even_when_hidden t name with | None -> Exn.code_error "Lib.DB.get_compile_info got library that doesn't exist" - [ "name", Sexp.To_sexp.string name ] + [ "name", Lib_name.to_sexp name ] | Some lib -> let t = Option.some_if (not allow_overlaps) t in Compile.for_lib t lib @@ -1060,7 +1062,7 @@ module DB = struct let resolve_pps t pps = resolve_simple_deps t ~allow_private_deps:true - (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * string) list) + (pps : (Loc.t * Dune_file.Pp.t) list :> (Loc.t * Lib_name.t) list) ~stack:Dep_stack.empty let rec all ?(recursive=false) t = @@ -1081,8 +1083,8 @@ end module Meta = struct let to_names ts = - List.fold_left ts ~init:String.Set.empty ~f:(fun acc t -> - String.Set.add acc t.name) + List.fold_left ts ~init:Lib_name.Set.empty ~f:(fun acc t -> + Lib_name.Set.add acc t.name) (* For the deprecated method, we need to put all the runtime dependencies of the transitive closure. @@ -1110,30 +1112,34 @@ let report_lib_error ppf (e : Error.t) = match e with | Library_not_available { loc = _; name; reason } -> Format.fprintf ppf - "@{Error@}: Library %S %a.@\n" - name + "@{Error@}: Library %a %a.@\n" + Lib_name.pp_quoted name Error.Library_not_available.Reason.pp reason | Conflict { lib1 = (lib1, rb1); lib2 = (lib2, rb2) } -> Format.fprintf ppf "@[@{Error@}: Conflict between the following libraries:@,\ - - %S in %s@,\ + - %a in %s@,\ \ %a@,\ - - %S in %s@,\ + - %a in %s@,\ \ %a@,\ This cannot work.@\n" - lib1.name (Path.to_string_maybe_quoted lib1.info.src_dir) + Lib_name.pp_quoted lib1.name + (Path.to_string_maybe_quoted lib1.info.src_dir) Dep_path.Entries.pp rb1 - lib2.name (Path.to_string_maybe_quoted lib2.info.src_dir) + Lib_name.pp_quoted lib2.name + (Path.to_string_maybe_quoted lib2.info.src_dir) Dep_path.Entries.pp rb2 | Overlap { in_workspace = lib1; installed = (lib2, rb2) } -> Format.fprintf ppf "@[@{Error@}: Conflict between the following libraries:@,\ - - %S in %s@,\ - - %S in %s@,\ + - %a in %s@,\ + - %a in %s@,\ \ %a@,\ This is not allowed.@\n" - lib1.name (Path.to_string_maybe_quoted lib1.info.src_dir) - lib2.name (Path.to_string_maybe_quoted lib2.info.src_dir) + Lib_name.pp_quoted lib1.name + (Path.to_string_maybe_quoted lib1.info.src_dir) + Lib_name.pp_quoted lib2.name + (Path.to_string_maybe_quoted lib2.info.src_dir) Dep_path.Entries.pp rb2 | No_solution_found_for_select { loc } -> Format.fprintf ppf @@ -1145,15 +1151,15 @@ let report_lib_error ppf (e : Error.t) = following libraries:@\n\ @[%a@]\n" (Format.pp_print_list (fun ppf (path, name) -> - Format.fprintf ppf "-> %S in %s" - name (Path.to_string_maybe_quoted path))) + Format.fprintf ppf "-> %a in %s" + Lib_name.pp_quoted name (Path.to_string_maybe_quoted path))) cycle | Private_deps_not_allowed t -> Format.fprintf ppf - "@{Error@}: Library %S is private, it cannot be a dependency of \ - a public library.\nYou need to give %S a public name.\n" - t.private_dep.name - t.private_dep.name + "@{Error@}: Library %a is private, it cannot be a dependency of \ + a public library.\nYou need to give %a a public name.\n" + Lib_name.pp_quoted t.private_dep.name + Lib_name.pp_quoted t.private_dep.name let () = Report_error.register (fun exn -> diff --git a/src/lib.mli b/src/lib.mli index bfb43aec..2d6644c6 100644 --- a/src/lib.mli +++ b/src/lib.mli @@ -8,7 +8,7 @@ type t (** For libraries defined in the workspace, this is the [public_name] if present or the [name] if not. *) -val name : t -> string +val name : t -> Lib_name.t (* CR-someday diml: this should be [Path.t list], since some libraries have multiple source directories because of [copy_files]. *) @@ -83,7 +83,7 @@ end module Info : sig module Deps : sig type t = - | Simple of (Loc.t * string) list + | Simple of (Loc.t * Lib_name.t) list | Complex of Dune_file.Lib_dep.t list end @@ -102,10 +102,10 @@ module Info : sig ; foreign_archives : Path.t list Mode.Dict.t (** [.a/.lib/...] files *) ; jsoo_runtime : Path.t list ; requires : Deps.t - ; ppx_runtime_deps : (Loc.t * string) list + ; ppx_runtime_deps : (Loc.t * Lib_name.t) list ; pps : (Loc.t * Dune_file.Pp.t) list ; optional : bool - ; virtual_deps : (Loc.t * string) list + ; virtual_deps : (Loc.t * Lib_name.t) list ; dune_version : Syntax.Version.t option ; sub_systems : Dune_file.Sub_system_info.t Sub_system_name.Map.t } @@ -126,7 +126,7 @@ module Error : sig module Reason : sig module Hidden : sig type t = - { name : string + { name : Lib_name.t ; path : Path.t ; reason : string } @@ -142,7 +142,7 @@ module Error : sig type nonrec t = { loc : Loc.t (** For names coming from Jbuild files *) - ; name : string + ; name : Lib_name.t ; reason : Reason.t } end @@ -178,7 +178,7 @@ module Error : sig type t = | Library_not_available of Library_not_available.t | No_solution_found_for_select of No_solution_found_for_select.t - | Dependency_cycle of (Path.t * string) list + | Dependency_cycle of (Path.t * Lib_name.t) list | Conflict of Conflict.t | Overlap of Overlap.t | Private_deps_not_allowed of Private_deps_not_allowed.t @@ -242,7 +242,7 @@ module DB : sig | Not_found | Found of Info.t | Hidden of Info.t * string - | Redirect of t option * string + | Redirect of t option * Lib_name.t end (** Create a new library database. [resolve] is used to resolve @@ -255,8 +255,8 @@ module DB : sig *) val create : ?parent:t - -> resolve:(string -> Resolve_result.t) - -> all:(unit -> string list) + -> resolve:(Lib_name.t -> Resolve_result.t) + -> all:(unit -> Lib_name.t list) -> unit -> t @@ -272,21 +272,21 @@ module DB : sig -> Findlib.t -> t - val find : t -> string -> (lib, Error.Library_not_available.Reason.t) result + val find : t -> Lib_name.t -> (lib, Error.Library_not_available.Reason.t) result val find_many : t - -> string list + -> Lib_name.t list -> lib list Or_exn.t - val find_even_when_hidden : t -> string -> lib option + val find_even_when_hidden : t -> Lib_name.t -> lib option - val available : t -> string -> bool + val available : t -> Lib_name.t -> bool (** Retrieve the compile information for the given library. Works for libraries that are optional and not available as well. *) - val get_compile_info : t -> ?allow_overlaps:bool -> string -> Compile.t + val get_compile_info : t -> ?allow_overlaps:bool -> Lib_name.t -> Compile.t - val resolve : t -> Loc.t * string -> lib Or_exn.t + val resolve : t -> Loc.t * Lib_name.t -> lib Or_exn.t (** Resolve libraries written by the user in a jbuild file. The resulting list of libraries is transitively closed and sorted by @@ -327,7 +327,7 @@ module Sub_system : sig type t type sub_system += T of t val instantiate - : resolve:(Loc.t * string -> lib Or_exn.t) + : resolve:(Loc.t * Lib_name.t -> lib Or_exn.t) -> get:(loc:Loc.t -> lib -> t option) -> lib -> Info.t @@ -346,7 +346,7 @@ end with type lib := t (** {1 Dependencies for META files} *) module Meta : sig - val requires : t -> String.Set.t - val ppx_runtime_deps : t -> String.Set.t - val ppx_runtime_deps_for_deprecated_method : t -> String.Set.t + val requires : t -> Lib_name.Set.t + val ppx_runtime_deps : t -> Lib_name.Set.t + val ppx_runtime_deps_for_deprecated_method : t -> Lib_name.Set.t end diff --git a/src/lib_deps_info.ml b/src/lib_deps_info.ml index 51891671..edabd4d1 100644 --- a/src/lib_deps_info.ml +++ b/src/lib_deps_info.ml @@ -11,10 +11,10 @@ module Kind = struct | _ -> Required end -type t = Kind.t String.Map.t +type t = Kind.t Lib_name.Map.t let merge a b = - String.Map.merge a b ~f:(fun _ a b -> + Lib_name.Map.merge a b ~f:(fun _ a b -> match a, b with | None, None -> None | x, None | None, x -> x diff --git a/src/lib_deps_info.mli b/src/lib_deps_info.mli index 4983b88a..5f5a6f35 100644 --- a/src/lib_deps_info.mli +++ b/src/lib_deps_info.mli @@ -13,6 +13,6 @@ module Kind : sig val merge : t -> t -> t end -type t = Kind.t String.Map.t +type t = Kind.t Lib_name.Map.t val merge : t -> t -> t diff --git a/src/lib_name.ml b/src/lib_name.ml new file mode 100644 index 00000000..bdc1231a --- /dev/null +++ b/src/lib_name.ml @@ -0,0 +1,124 @@ +open Stdune + +exception Invalid_lib_name of string + +let dgen = Dsexp.To_sexp.string +let dparse = Dsexp.Of_sexp.string + +module Local = struct + type t = string + + type result = + | Ok of t + | Warn of t + | Invalid + + let valid_char = function + | 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true + | _ -> false + + let of_string (name : string) = + match name with + | "" -> Invalid + | (s : string) -> + if s.[0] = '.' then + Invalid + else + let len = String.length s in + let rec loop warn i = + if i = len - 1 then + if warn then Warn s else Ok s + else + let c = String.unsafe_get s i in + if valid_char c then + loop warn (i + 1) + else if c = '.' then + loop true (i + 1) + else + Invalid + in + loop false 0 + + let of_string_exn s = + match of_string s with + | Ok s -> s + | Warn _ + | Invalid -> raise (Invalid_lib_name s) + + let dparse_loc = + Dsexp.Of_sexp.plain_string (fun ~loc s -> (loc, of_string s)) + + let dgen = Dsexp.To_sexp.string + + let to_sexp = Sexp.To_sexp.string + + let pp_quoted fmt t = Format.fprintf fmt "%S" t + + let invalid_message = + "invalid library name.\n\ + Hint: library names must be non-empty and composed only of \ + the following characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'" + + let wrapped_message = + sprintf + "%s.\n\ + This is temporary allowed for libraries with (wrapped false).\ + \nIt will not be supported in the future. \ + Please choose a valid name field." + invalid_message + + let validate (loc, res) ~wrapped = + match res, wrapped with + | Ok s, _ -> s + | Warn _, true -> Errors.fail loc "%s" wrapped_message + | Warn s, false -> Errors.warn loc "%s" wrapped_message; s + | Invalid, _ -> Errors.fail loc "%s" invalid_message + + let to_string s = s +end + +let split t = + match String.split t ~on:'.' with + | [] -> assert false + | pkg :: rest -> (Package.Name.of_string pkg, rest) + +let pp = Format.pp_print_string + +let pp_quoted fmt t = Format.fprintf fmt "%S" t + +let compare = String.compare + +let to_local = Local.of_string + +let to_sexp t = Sexp.Atom t + +let to_string t = t + +let of_string_exn ~loc:_ s = s + +let of_local t = t + +type t = string + +module Map = Map.Make(String) +module Set = struct + include Set.Make(String) + + let to_string_list = to_list +end + +let root_lib t = + match String.lsplit2 t ~on:'.' with + | None -> t + | Some (p, _) -> p + +let package_name t = + Package.Name.of_string (root_lib t) + +let nest x y = sprintf "%s.%s" x y + +module L = struct + let to_key = function + | [] -> "+none+" + | names -> String.concat ~sep:"+" names +end diff --git a/src/lib_name.mli b/src/lib_name.mli new file mode 100644 index 00000000..0e4124e2 --- /dev/null +++ b/src/lib_name.mli @@ -0,0 +1,63 @@ +open Stdune + +type t + +val of_string_exn : loc:Loc.t option -> string -> t +val to_string : t -> string + +include Dsexp.Sexpable with type t := t + +module Local : sig + type t + + type result = + | Ok of t + | Warn of t + | Invalid + + val dgen : t Dsexp.To_sexp.t + val dparse_loc : (Loc.t * result) Dsexp.Of_sexp.t + val validate : (Loc.t * result) -> wrapped:bool -> t + + val to_sexp : t Sexp.To_sexp.t + + val of_string_exn : string -> t + + val of_string : string -> result + + val to_string : t -> string + + val invalid_message : string + + val pp_quoted : t Fmt.t +end + +val compare : t -> t -> Ordering.t + +val pp : t Fmt.t + +val pp_quoted : t Fmt.t + +val of_local : Local.t -> t + +val to_local : t -> Local.result + +val split : t -> Package.Name.t * string list + +val package_name : t -> Package.Name.t + +val root_lib : t -> t + +module Map : Map.S with type key = t +module Set : sig + include Set.S with type elt = t + val to_string_list : t -> string list +end + +val to_sexp : t Sexp.To_sexp.t + +val nest : t -> t -> t + +module L : sig + val to_key : t list -> string +end diff --git a/src/lib_rules.ml b/src/lib_rules.ml index a3761ea5..2db4c20a 100644 --- a/src/lib_rules.ml +++ b/src/lib_rules.ml @@ -35,7 +35,7 @@ module Gen (P : Install_rules.Params) = struct if not (Library.has_stubs lib) then [] else - let stubs_name = lib.name ^ "_stubs" in + let stubs_name = Lib_name.Local.to_string lib.name ^ "_stubs" in match mode with | Byte -> ["-dllib"; "-l" ^ stubs_name; "-cclib"; "-l" ^ stubs_name] | Native -> ["-cclib"; "-l" ^ stubs_name] @@ -175,7 +175,8 @@ module Gen (P : Install_rules.Params) = struct [ As (Utils.g ()) ; if custom then A "-custom" else As [] ; A "-o" - ; Path (Path.relative dir (sprintf "%s_stubs" lib.name)) + ; Path (Path.relative dir (sprintf "%s_stubs" + (Lib_name.Local.to_string lib.name))) ; Deps o_files ; Dyn (fun cclibs -> (* https://github.com/ocaml/dune/issues/119 *) @@ -421,7 +422,7 @@ module Gen (P : Install_rules.Params) = struct let rules (lib : Library.t) ~dir_contents ~dir ~scope ~dir_kind : Compilation_context.t * Merlin.t = let compile_info = - Lib.DB.get_compile_info (Scope.libs scope) lib.name + Lib.DB.get_compile_info (Scope.libs scope) (Library.best_name lib) ~allow_overlaps:lib.buildable.allow_overlapping_dependencies in SC.Libs.gen_select_rules sctx compile_info ~dir; diff --git a/src/main.ml b/src/main.ml index dbeab71f..30f71d93 100644 --- a/src/main.ml +++ b/src/main.ml @@ -133,8 +133,8 @@ let external_lib_deps ?log ~packages () = Path.Map.map (Build_system.all_lib_deps setup.build_system ~request:(Build.paths install_files)) - ~f:(String.Map.filteri ~f:(fun name _ -> - not (String.Set.mem internals name)))) + ~f:(Lib_name.Map.filteri ~f:(fun name _ -> + not (Lib_name.Set.mem internals name)))) let ignored_during_bootstrap = Path.Set.of_list diff --git a/src/merlin.ml b/src/merlin.ml index d3ba58c0..d91552ac 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -70,7 +70,7 @@ type t = { requires : Lib.Set.t ; flags : (unit, string list) Build.t ; preprocess : Preprocess.t - ; libname : string option + ; libname : Lib_name.Local.t option ; source_dirs: Path.Set.t ; objs_dirs : Path.Set.t } diff --git a/src/merlin.mli b/src/merlin.mli index 3902f999..66dd723c 100644 --- a/src/merlin.mli +++ b/src/merlin.mli @@ -9,7 +9,7 @@ val make : ?requires:Lib.t list Or_exn.t -> ?flags:(unit, string list) Build.t -> ?preprocess:Dune_file.Preprocess.t - -> ?libname:string + -> ?libname:Lib_name.Local.t -> ?source_dirs: Path.Set.t -> ?objs_dirs:Path.Set.t -> unit diff --git a/src/meta.ml b/src/meta.ml index f26722fb..6fd71942 100644 --- a/src/meta.ml +++ b/src/meta.ml @@ -2,7 +2,7 @@ open! Stdune open Import type t = - { name : string + { name : Lib_name.t option ; entries : entry list } @@ -34,7 +34,7 @@ module Parse = struct | String s -> if String.contains s '.' then error lb "'.' not allowed in sub-package names"; - s + Lib_name.of_string_exn ~loc:None s | _ -> error lb "package name expected" let string lb = @@ -88,7 +88,8 @@ module Parse = struct let name = package_name lb in lparen lb; let sub_entries = entries lb (depth + 1) [] in - entries lb depth (Package { name; entries = sub_entries } :: acc) + entries lb depth (Package { name = Some name; entries = sub_entries } + :: acc) | Name var -> let predicates, action = match next lb with @@ -134,14 +135,14 @@ module Simplified = struct end type t = - { name : string + { name : Lib_name.t option ; vars : Rules.t String.Map.t ; subs : t list } let rec pp fmt t = Fmt.record fmt - [ "name", Fmt.const Fmt.quoted t.name + [ "name", Fmt.const (Fmt.optional Lib_name.pp_quoted) t.name ; "vars", Fmt.const (String.Map.pp Rules.pp) t.vars ; "subs", Fmt.const (Fmt.ocaml_list pp) t.subs ] @@ -196,9 +197,15 @@ let archives name = let builtins ~stdlib_dir = let version = version "[distributed with Ocaml]" in - let simple name ?dir ?(archive_name=name) deps = + let simple name ?dir ?archive_name deps = + let archive_name = + match archive_name with + | None -> name + | Some a -> a + in + let name = Lib_name.of_string_exn ~loc:None name in let archives = archives archive_name in - { name + { name = Some name ; entries = (requires deps :: version :: @@ -211,7 +218,7 @@ let builtins ~stdlib_dir = let sub name deps = Package (simple name deps ~archive_name:("ocaml" ^ name)) in - { name = "compiler-libs" + { name = Some (Lib_name.of_string_exn ~loc:None "compiler-libs") ; entries = [ requires [] ; version @@ -227,7 +234,7 @@ let builtins ~stdlib_dir = let unix = simple "unix" [] ~dir:"+" in let bigarray = simple "bigarray" ["unix"] ~dir:"+" in let threads = - { name = "threads" + { name = Some (Lib_name.of_string_exn ~loc:None "threads") ; entries = [ version ; requires ~preds:[Pos "mt"; Pos "mt_vm" ] ["threads.vm"] @@ -242,7 +249,7 @@ let builtins ~stdlib_dir = } in let num = - { name = "num" + { name = Some (Lib_name.of_string_exn ~loc:None "num") ; entries = [ requires ["num.core"] ; version @@ -259,8 +266,9 @@ let builtins ~stdlib_dir = else [ compiler_libs; str; unix; bigarray; threads ] in - List.map libs ~f:(fun t -> t.name, simplify t) - |> String.Map.of_list_exn + List.filter_map libs ~f:(fun t -> + Option.map t.name ~f:(fun name -> name, simplify t)) + |> Lib_name.Map.of_list_exn let string_of_action = function | Set -> "=" @@ -313,5 +321,10 @@ and pp_entry ppf entry = var (String.concat ~sep:"," (List.map predicates ~f:string_of_predicate)) (string_of_action action) (pp_quoted_value var) value | Package { name; entries } -> + let name = + match name with + | None -> "" + | Some l -> Lib_name.to_string l + in fprintf ppf "@[package %S (@,%a@]@,)" name pp entries diff --git a/src/meta.mli b/src/meta.mli index ee617489..3cc1668c 100644 --- a/src/meta.mli +++ b/src/meta.mli @@ -4,7 +4,7 @@ open! Stdune open! Import type t = - { name : string + { name : Lib_name.t option ; entries : entry list } @@ -35,7 +35,7 @@ module Simplified : sig end type t = - { name : string + { name : Lib_name.t option ; vars : Rules.t String.Map.t ; subs : t list } @@ -43,10 +43,10 @@ module Simplified : sig val pp : Format.formatter -> t -> unit end -val load : Path.t -> name:string -> Simplified.t +val load : Path.t -> name:Lib_name.t option -> Simplified.t (** Builtin META files for libraries distributed with the compiler. For when ocamlfind is not installed. *) -val builtins : stdlib_dir:Path.t -> Simplified.t String.Map.t +val builtins : stdlib_dir:Path.t -> Simplified.t Lib_name.Map.t val pp : Format.formatter -> entry list -> unit diff --git a/src/module.ml b/src/module.ml index 2ea6ad11..b06c6e7f 100644 --- a/src/module.ml +++ b/src/module.ml @@ -122,7 +122,8 @@ let iter t ~f = Option.iter t.intf ~f:(f Ml_kind.Intf) let with_wrapper t ~libname = - { t with obj_name = sprintf "%s__%s" libname t.name } + { t with obj_name + = sprintf "%s__%s" (Lib_name.Local.to_string libname) t.name } let map_files t ~f = { t with diff --git a/src/module.mli b/src/module.mli index 94dbeb8c..4ac943b9 100644 --- a/src/module.mli +++ b/src/module.mli @@ -87,7 +87,7 @@ val iter : t -> f:(Ml_kind.t -> File.t -> unit) -> unit val has_impl : t -> bool (** Prefix the object name with the library name. *) -val with_wrapper : t -> libname:string -> t +val with_wrapper : t -> libname:Lib_name.Local.t -> t val map_files : t -> f:(Ml_kind.t -> File.t -> File.t) -> t diff --git a/src/odoc.ml b/src/odoc.ml index d9f3cff7..19e01cfe 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -11,8 +11,9 @@ let lib_unique_name lib = let name = Lib.name lib in match Lib.status lib with | Installed -> assert false - | Public _ -> name - | Private scope_name -> SC.Scope_key.to_string name scope_name + | Public _ -> Lib_name.to_string name + | Private scope_name -> + SC.Scope_key.to_string (Lib_name.to_string name) scope_name let pkg_or_lnu lib = match Lib.package lib with @@ -196,7 +197,7 @@ module Gen (S : sig val sctx : SC.t end) = struct ~requires ~(dep_graphs:Ocamldep.Dep_graph.t Ml_kind.Dict.t) = let lib = Option.value_exn (Lib.DB.find_even_when_hidden (Scope.libs scope) - library.name) in + (Library.best_name library)) in (* Using the proper package name doesn't actually work since odoc assumes that a package contains only 1 library *) let pkg_or_lnu = pkg_or_lnu lib in @@ -350,6 +351,7 @@ module Gen (S : sig val sctx : SC.t end) = struct () (* rules were already setup lazily in gen_rules *) | "_odoc" :: "lib" :: lib :: _ -> let lib, lib_db = SC.Scope_key.of_string sctx lib in + let lib = Lib_name.of_string_exn ~loc:None lib in begin match Lib.DB.find lib_db lib with | Error _ -> () | Ok lib -> SC.load_dir sctx ~dir:(Lib.src_dir lib) @@ -358,6 +360,7 @@ module Gen (S : sig val sctx : SC.t end) = struct (* TODO we can be a better with the error handling in the case where lib_unique_name_or_pkg is neither a valid pkg or lnu *) let lib, lib_db = SC.Scope_key.of_string sctx lib_unique_name_or_pkg in + let lib = Lib_name.of_string_exn ~loc:None lib in let setup_pkg_html_rules pkg = setup_pkg_html_rules ~pkg ~libs:( Lib.Set.to_list (load_all_odoc_rules_pkg ~pkg)) in @@ -413,9 +416,9 @@ module Gen (S : sig val sctx : SC.t end) = struct let b = Buffer.create 512 in Lib.Map.to_list entry_modules |> List.sort ~compare:(fun (x, _) (y, _) -> - String.compare (Lib.name x) (Lib.name y)) + Lib_name.compare (Lib.name x) (Lib.name y)) |> List.iter ~f:(fun (lib, modules) -> - Printf.bprintf b "{2 Library %s}\n" (Lib.name lib); + Printf.bprintf b "{2 Library %s}\n" (Lib_name.to_string (Lib.name lib)); Buffer.add_string b ( match modules with | [ x ] -> @@ -513,7 +516,8 @@ module Gen (S : sig val sctx : SC.t end) = struct | None -> let scope = SC.find_scope_by_dir sctx w.ctx_dir in Some (Option.value_exn ( - Lib.DB.find_even_when_hidden (Scope.libs scope) l.name) + Lib.DB.find_even_when_hidden (Scope.libs scope) + (Library.best_name l)) ) end | _ -> None diff --git a/src/preprocessing.ml b/src/preprocessing.ml index ff20c1ea..d777b6e3 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -27,7 +27,7 @@ module Driver = struct ; as_ppx_flags : Ordered_set_lang.Unexpanded.t ; lint_flags : Ordered_set_lang.Unexpanded.t ; main : string - ; replaces : (Loc.t * string) list + ; replaces : (Loc.t * Lib_name.t) list } type Dune_file.Sub_system_info.t += T of t @@ -53,7 +53,8 @@ module Driver = struct ~check:(Syntax.since syntax (1, 1)) and lint_flags = Ordered_set_lang.Unexpanded.field "lint_flags" and main = field "main" string - and replaces = field "replaces" (list (located string)) ~default:[] + and replaces = + field "replaces" (list (located (Lib_name.dparse))) ~default:[] in { loc ; flags @@ -92,14 +93,15 @@ module Driver = struct resolve x >>= fun lib -> match get ~loc lib with | None -> - Error (Errors.exnf loc "%S is not a %s" name + Error (Errors.exnf loc "%a is not a %s" + Lib_name.pp_quoted name (desc ~plural:false)) | Some t -> Ok t)) } let dgen t = let open Dsexp.To_sexp in - let f x = string (Lib.name (Lazy.force x.lib)) in + let f x = Lib_name.dgen (Lib.name (Lazy.force x.lib)) in ((1, 0), record [ "flags" , Ordered_set_lang.Unexpanded.dgen @@ -139,7 +141,7 @@ module Driver = struct | _ -> match List.filter_map libs ~f:(fun lib -> - match Lib.name lib with + match Lib_name.to_string (Lib.name lib) with | "ocaml-migrate-parsetree" | "ppxlib" | "ppx_driver" as s -> Some s | _ -> None) @@ -171,7 +173,7 @@ module Driver = struct (sprintf "Too many incompatible ppx drivers were found: %s." (String.enumerate_and (List.map ts ~f:(fun t -> - Lib.name (lib t))))) + Lib_name.to_string (Lib.name (lib t)))))) | Error (Other exn) -> Error exn end @@ -197,7 +199,7 @@ module Jbuild_driver = struct ~lexer:Dsexp.Lexer.jbuild_token |> Dsexp.Of_sexp.parse Driver.Info.parse parsing_context in - (Pp.of_string name, + (Pp.of_string ~loc:None name, { info ; lib = lazy (assert false) ; replaces = Ok [] @@ -219,9 +221,9 @@ module Jbuild_driver = struct |} let drivers = - [ Pp.of_string "ocaml-migrate-parsetree.driver-main" , omp - ; Pp.of_string "ppxlib.runner" , ppxlib - ; Pp.of_string "ppx_driver.runner" , ppx_driver + [ Pp.of_string ~loc:None "ocaml-migrate-parsetree.driver-main" , omp + ; Pp.of_string ~loc:None "ppxlib.runner" , ppxlib + ; Pp.of_string ~loc:None "ppx_driver.runner" , ppx_driver ] let get_driver pps = @@ -270,7 +272,7 @@ let build_ppx_driver sctx ~lib_db ~dep_kind ~target ~dir_kind pps = (* Extend the dependency stack as we don't have locations at this point *) Dep_path.prepend_exn e - (Preprocess (pps : Dune_file.Pp.t list :> string list))) + (Preprocess (pps : Dune_file.Pp.t list :> Lib_name.t list))) (Lib.DB.resolve_pps lib_db (List.map pps ~f:(fun x -> (Loc.none, x))) >>= Lib.closure @@ -321,7 +323,7 @@ let get_rules sctx key ~dir_kind = | [] -> [] | driver :: rest -> List.sort rest ~compare:String.compare @ [driver] in - let pps = List.map names ~f:Dune_file.Pp.of_string in + let pps = List.map names ~f:(Dune_file.Pp.of_string ~loc:None) in build_ppx_driver sctx pps ~lib_db ~dep_kind:Required ~target:exe ~dir_kind let gen_rules sctx components = @@ -334,10 +336,10 @@ let ppx_driver_exe sctx libs ~dir_kind = let names = let names = List.rev_map libs ~f:Lib.name in match (dir_kind : File_tree.Dune_file.Kind.t) with - | Dune -> List.sort names ~compare:String.compare + | Dune -> List.sort names ~compare:Lib_name.compare | Jbuild -> match names with - | last :: others -> List.sort others ~compare:String.compare @ [last] + | last :: others -> List.sort others ~compare:Lib_name.compare @ [last] | [] -> [] in let scope_for_key = @@ -354,11 +356,7 @@ let ppx_driver_exe sctx libs ~dir_kind = | None , Some _ -> scope_for_key | None , None -> None) in - let key = - match names with - | [] -> "+none+" - | _ -> String.concat names ~sep:"+" - in + let key = Lib_name.L.to_key names in let key = match scope_for_key with | None -> key @@ -373,6 +371,7 @@ module Compat_ppx_exe_kind = struct end let get_compat_ppx_exe sctx ~name ~kind = + let name = Lib_name.to_string name in match (kind : Compat_ppx_exe_kind.t) with | Dune -> ppx_exe sctx ~key:name ~dir_kind:Dune @@ -410,7 +409,8 @@ let workspace_root_var = String_with_vars.virt_var __POS__ "workspace_root" let cookie_library_name lib_name = match lib_name with | None -> [] - | Some name -> ["--cookie"; sprintf "library-name=%S" name] + | Some name -> + ["--cookie"; sprintf "library-name=%S" (Lib_name.Local.to_string name)] (* Generate rules for the reason modules in [modules] and return a a new module with only OCaml sources *) diff --git a/src/preprocessing.mli b/src/preprocessing.mli index e58b5571..28b891b7 100644 --- a/src/preprocessing.mli +++ b/src/preprocessing.mli @@ -15,7 +15,7 @@ val make -> lint:Dune_file.Preprocess_map.t -> preprocess:Dune_file.Preprocess_map.t -> preprocessor_deps:(unit, Path.t list) Build.t - -> lib_name:string option + -> lib_name:Lib_name.Local.t option -> scope:Scope.t -> dir_kind:File_tree.Dune_file.Kind.t -> t @@ -56,12 +56,12 @@ end (** Compatibility [ppx.exe] program for the findlib method. *) val get_compat_ppx_exe : Super_context.t - -> name:string + -> name:Lib_name.t -> kind:Compat_ppx_exe_kind.t -> Path.t (** [cookie_library_name lib_name] is ["--cookie"; lib_name] if [lib_name] is not [None] *) -val cookie_library_name : string option -> string list +val cookie_library_name : Lib_name.Local.t option -> string list val gen_rules : Super_context.t -> string list -> unit diff --git a/src/scope.ml b/src/scope.ml index 6e0b9089..0889de64 100644 --- a/src/scope.ml +++ b/src/scope.ml @@ -79,7 +79,7 @@ module DB = struct List.filter_map internal_libs ~f:(fun (_dir, lib) -> Option.map lib.public ~f:(fun p -> (Dune_file.Public_lib.name p, lib.project))) - |> String.Map.of_list + |> Lib_name.Map.of_list |> function | Ok x -> x | Error (name, _, _) -> @@ -91,17 +91,17 @@ module DB = struct with | [] | [_] -> assert false | loc1 :: loc2 :: _ -> - die "Public library %S is defined twice:\n\ + die "Public library %a is defined twice:\n\ - %s\n\ - %s" - name + Lib_name.pp_quoted name (Loc.to_file_colon_line loc1) (Loc.to_file_colon_line loc2) in Lib.DB.create () ~parent:installed_libs ~resolve:(fun name -> - match String.Map.find public_libs name with + match Lib_name.Map.find public_libs name with | None -> Not_found | Some project -> let scope = @@ -109,7 +109,7 @@ module DB = struct (Project_name_map.find !by_name_cell (Dune_project.name project)) in Redirect (Some scope.db, name)) - ~all:(fun () -> String.Map.keys public_libs) + ~all:(fun () -> Lib_name.Map.keys public_libs) in let by_name = let build_context_dir = Path.relative Path.build_dir context in diff --git a/src/stdune/fmt.ml b/src/stdune/fmt.ml index eebd3ed8..22bf3b7d 100644 --- a/src/stdune/fmt.ml +++ b/src/stdune/fmt.ml @@ -54,3 +54,7 @@ let record fmt = function let tuple ppfa ppfb fmt (a, b) = Format.fprintf fmt "@[(%a, %a)@]" ppfa a ppfb b + +let optional ppf fmt = function + | None -> Format.fprintf fmt "" + | Some a -> ppf fmt a diff --git a/src/stdune/fmt.mli b/src/stdune/fmt.mli index eaa53cc7..1d253a98 100644 --- a/src/stdune/fmt.mli +++ b/src/stdune/fmt.mli @@ -24,3 +24,5 @@ val record : (string * unit t) list t val tuple : 'a t -> 'b t -> ('a * 'b) t val nl : unit t + +val optional : 'a t -> 'a option t diff --git a/src/sub_system.ml b/src/sub_system.ml index 75e0559a..6bad3b48 100644 --- a/src/sub_system.ml +++ b/src/sub_system.ml @@ -40,7 +40,8 @@ module Register_backend(M : Backend) = struct Lib.DB.resolve db (loc, name) >>= fun lib -> match get lib with | None -> - Error (Errors.exnf loc "%S is not %s %s" name M.desc_article + Error (Errors.exnf loc "%a is not %s %s" Lib_name.pp_quoted name + M.desc_article (M.desc ~plural:false)) | Some t -> Ok t @@ -60,7 +61,7 @@ module Register_backend(M : Backend) = struct (List.map backends ~f:(fun t -> let lib = M.lib t in sprintf "- %S in %s" - (Lib.name lib) + (Lib_name.to_string (Lib.name lib)) (Path.to_string_maybe_quoted (Lib.src_dir lib))))) | No_backend_found -> Errors.exnf loc "No %s found." (M.desc ~plural:false) diff --git a/src/sub_system_intf.ml b/src/sub_system_intf.ml index 428e6ef7..1a97964c 100644 --- a/src/sub_system_intf.ml +++ b/src/sub_system_intf.ml @@ -12,7 +12,7 @@ module type S = sig (** Create an instance of the sub-system *) val instantiate - : resolve:(Loc.t * string -> Lib.t Or_exn.t) + : resolve:(Loc.t * Lib_name.t -> Lib.t Or_exn.t) -> get:(loc:Loc.t -> Lib.t -> t option) -> Lib.t -> Info.t @@ -44,7 +44,7 @@ module type Registered_backend = sig val get : Lib.t -> t option (** Resolve a backend name *) - val resolve : Lib.DB.t -> Loc.t * string -> t Or_exn.t + val resolve : Lib.DB.t -> Loc.t * Lib_name.t -> t Or_exn.t module Selection_error : sig type nonrec t = @@ -105,7 +105,7 @@ module type End_point = sig include Info (** Additional backends specified by the user at use-site *) - val backends : t -> (Loc.t * string) list option + val backends : t -> (Loc.t * Lib_name.t) list option end val gen_rules diff --git a/src/super_context.ml b/src/super_context.ml index 8311c97c..37e21b7b 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -71,16 +71,16 @@ let build_system t = t.build_system let host t = Option.value t.host ~default:t let internal_lib_names t = - List.fold_left t.stanzas ~init:String.Set.empty + List.fold_left t.stanzas ~init:Lib_name.Set.empty ~f:(fun acc { Dir_with_jbuild. stanzas; _ } -> List.fold_left stanzas ~init:acc ~f:(fun acc -> function | Library lib -> - String.Set.add + Lib_name.Set.add (match lib.public with | None -> acc | Some { name = (_, name); _ } -> - String.Set.add acc name) - lib.name + Lib_name.Set.add acc name) + (Lib_name.of_local lib.name) | _ -> acc)) let public_libs t = t.public_libs @@ -235,13 +235,13 @@ end = struct let empty () = { failures = [] - ; lib_deps = String.Map.empty + ; lib_deps = Lib_name.Map.empty ; sdeps = Path.Set.empty ; ddeps = String.Map.empty } let add_lib_dep acc lib kind = - acc.lib_deps <- String.Map.add acc.lib_deps lib kind + acc.lib_deps <- Lib_name.Map.add acc.lib_deps lib kind let add_fail acc fail = acc.failures <- fail :: acc.failures; @@ -261,7 +261,7 @@ end = struct match String.lsplit2 s ~on:':' with | None -> Errors.fail loc "invalid %%{lib:...} form: %s" s - | Some x -> x + | Some (lib, f) -> (Lib_name.of_string_exn ~loc:(Some loc) lib, f) open Build.O @@ -330,7 +330,7 @@ end = struct end end | Macro (Lib_available, s) -> begin - let lib = s in + let lib = Lib_name.of_string_exn ~loc:(Some loc) s in Resolved_forms.add_lib_dep acc lib Optional; Some (str_exp (string_of_bool ( Lib.DB.available (Scope.libs scope) lib))) @@ -540,7 +540,8 @@ let create List.filter_map stanzas ~f:(fun stanza -> let keep = match (stanza : Stanza.t) with - | Library lib -> Lib.DB.available (Scope.libs scope) lib.name + | Library lib -> + Lib.DB.available (Scope.libs scope) (Library.best_name lib) | Documentation _ | Install _ -> true | _ -> false @@ -696,7 +697,7 @@ module Libs = struct prefix_rules t prefix ~f let lib_files_alias ~dir ~name ~ext = - Alias.make (sprintf "lib-%s%s-all" name ext) ~dir + Alias.make (sprintf "lib-%s%s-all" (Lib_name.to_string name) ext) ~dir let setup_file_deps_alias t ~dir ~ext lib files = add_alias_deps t diff --git a/src/super_context.mli b/src/super_context.mli index 32d4e60b..d05824d4 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -63,7 +63,7 @@ val public_libs : t -> Lib.DB.t val installed_libs : t -> Lib.DB.t (** All non-public library names *) -val internal_lib_names : t -> String.Set.t +val internal_lib_names : t -> Lib_name.Set.t (** Compute the ocaml flags based on the directory environment and a buildable stanza *) diff --git a/src/utils.ml b/src/utils.ml index 0f500011..4b78ac63 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -107,7 +107,7 @@ let describe_target fn = Path.to_string_maybe_quoted fn let library_object_directory ~dir name = - Path.relative dir ("." ^ name ^ ".objs") + Path.relative dir ("." ^ Lib_name.Local.to_string name ^ ".objs") (* Use "eobjs" rather than "objs" to avoid a potential conflict with a library of the same name *) diff --git a/src/utils.mli b/src/utils.mli index c6bd83d4..e1a2875e 100644 --- a/src/utils.mli +++ b/src/utils.mli @@ -19,7 +19,7 @@ val describe_target : Path.t -> string library should be stored. *) val library_object_directory : dir:Path.t - -> string + -> Lib_name.Local.t -> Path.t (** Return the directory where the object files for the given diff --git a/src/utop.ml b/src/utop.ml index c70f71f4..84e694b5 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -65,7 +65,8 @@ let setup sctx ~dir ~(libs : Library.t list) ~scope = let requires = let open Result.O in Lib.DB.find_many (Scope.libs scope) - ("utop" :: List.map libs ~f:(fun (lib : Library.t) -> lib.name)) + (Lib_name.of_string_exn ~loc:None "utop" + :: List.map libs ~f:Library.best_name) >>= Lib.closure in let cctx = diff --git a/test/unit-tests/tests.mlt b/test/unit-tests/tests.mlt index 4775b665..32c85644 100644 --- a/test/unit-tests/tests.mlt +++ b/test/unit-tests/tests.mlt @@ -11,9 +11,11 @@ let () = ;; let print_pkg ppf pkg = - Format.fprintf ppf "" (Findlib.Package.name pkg) + Format.fprintf ppf "" + (Lib_name.to_string (Findlib.Package.name pkg)) ;; +#install_printer Lib_name.pp_quoted;; #install_printer print_pkg;; #install_printer String.Map.pp;; @@ -33,7 +35,7 @@ val findlib : Findlib.t = |}] let pkg = - match Findlib.find findlib "foo" with + match Findlib.find findlib (Lib_name.of_string_exn ~loc:None "foo") with | Ok x -> x | Error _ -> assert false;; @@ -45,7 +47,7 @@ val pkg : Findlib.Package.t = Findlib.Package.requires pkg;; [%%expect{| -- : string list = ["baz"] +- : Lib_name.t list = ["baz"] |}] (* +-----------------------------------------------------------------+ @@ -57,7 +59,7 @@ open Meta let meta = Path.in_source "test/unit-tests/findlib-db/foo/META" - |> Meta.load ~name:"foo" + |> Meta.load ~name:(Some (Lib_name.of_string_exn ~loc:None "foo")) [%%expect{| val meta : Simplified.t =