diff --git a/src/build_system.ml b/src/build_system.ml index b8fa87d7..ad3a2d82 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -1475,6 +1475,7 @@ let package_deps t pkg files = else List.fold_left pkgs ~init:acc ~f:add_package and add_package acc p = + let open Package.Name.Infix in if p = pkg then acc else diff --git a/src/dir_contents.ml b/src/dir_contents.ml index 7f3d362d..c2b9cb20 100644 --- a/src/dir_contents.ml +++ b/src/dir_contents.ml @@ -175,6 +175,7 @@ module Library_modules = struct if not lib.wrapped then modules else + let open Module.Name.Infix in Module.Name.Map.map modules ~f:(fun m -> if m.name = main_module_name then m @@ -409,6 +410,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules = match Module.Name.Map.of_list rev_modules with | Ok x -> x | Error (name, _, _) -> + let open Module.Name.Infix in let locs = List.filter_map rev_modules ~f:(fun (n, b) -> Option.some_if (n = name) b.loc) diff --git a/src/dune_project.ml b/src/dune_project.ml index 910ffd86..c40f4f6c 100644 --- a/src/dune_project.ml +++ b/src/dune_project.ml @@ -32,20 +32,28 @@ module Name : sig val named : string -> t option val anonymous_root : t + + module Infix : Comparable.OPS with type t = t end = struct - type t = - | Named of string - | Anonymous of Path.t + module T = struct + type t = + | Named of string + | Anonymous of Path.t + + let compare a b = + match a, b with + | Named x, Named y -> String.compare x y + | Anonymous x, Anonymous y -> Path.compare x y + | Named _, Anonymous _ -> Lt + | Anonymous _, Named _ -> Gt + end + + include T + + module Infix = Comparable.Operators(T) let anonymous_root = Anonymous Path.root - let compare a b = - match a, b with - | Named x, Named y -> String.compare x y - | Anonymous x, Anonymous y -> Path.compare x y - | Named _, Anonymous _ -> Lt - | Anonymous _, Named _ -> Gt - let to_string_hum = function | Named s -> s | Anonymous p -> sprintf "" (Path.to_string_maybe_quoted p) @@ -305,6 +313,7 @@ let default_name ~dir ~packages = | None -> Option.value_exn (Name.anonymous dir) | Some (_, pkg) -> let pkg = + let open Package.Name.Infix in Package.Name.Map.fold packages ~init:pkg ~f:(fun pkg acc -> if acc.Package.name <= pkg.Package.name then acc diff --git a/src/dune_project.mli b/src/dune_project.mli index e9fd5ca3..482d54b6 100644 --- a/src/dune_project.mli +++ b/src/dune_project.mli @@ -27,6 +27,8 @@ module Name : sig (** Convert to/from an encoded string that is suitable to use in filenames *) val encode : t -> string val decode : string -> t + + module Infix : Comparable.OPS with type t = t end module Project_file : sig diff --git a/src/module.ml b/src/module.ml index bd5f836c..7bc804d4 100644 --- a/src/module.ml +++ b/src/module.ml @@ -1,13 +1,17 @@ open Import module Name = struct - type t = string + module T = struct + type t = string + let compare = compare + end + + include T let t = Sexp.atom let add_suffix = (^) - let compare = compare let of_string = String.capitalize let to_string x = x @@ -19,6 +23,7 @@ module Name = struct module Set = String.Set module Map = String.Map module Top_closure = Top_closure.String + module Infix = Comparable.Operators(T) end module Syntax = struct diff --git a/src/module.mli b/src/module.mli index b9268c4d..8f5b4727 100644 --- a/src/module.mli +++ b/src/module.mli @@ -19,6 +19,8 @@ module Name : sig module Map : Map.S with type key = t module Top_closure : Top_closure.S with type key := t + + module Infix : Comparable.OPS with type t = t end module Syntax : sig diff --git a/src/ocamldep.ml b/src/ocamldep.ml index 2c11ee40..af61f85a 100644 --- a/src/ocamldep.ml +++ b/src/ocamldep.ml @@ -60,6 +60,7 @@ module Dep_graphs = struct end let parse_module_names ~(unit : Module.t) ~modules words = + let open Module.Name.Infix in List.filter_map words ~f:(fun m -> let m = Module.Name.of_string m in if m = unit.name then @@ -68,6 +69,7 @@ let parse_module_names ~(unit : Module.t) ~modules words = Module.Name.Map.find modules m) let is_alias_module cctx (m : Module.t) = + let open Module.Name.Infix in match CC.alias_module cctx with | None -> false | Some alias -> alias.name = m.name @@ -103,6 +105,7 @@ let parse_deps cctx ~file ~unit lines = (match lib_interface_module with | None -> () | Some (m : Module.t) -> + let open Module.Name.Infix in if unit.name <> m.name && not (is_alias_module cctx unit) && List.exists deps ~f:(fun x -> Module.name x = m.name) then die "Module %a in directory %s depends on %a.\n\ diff --git a/src/package.ml b/src/package.ml index 5979b5c3..af79aae1 100644 --- a/src/package.ml +++ b/src/package.ml @@ -1,12 +1,14 @@ open Stdune module Name = struct - include Interned.Make(struct + module T = Interned.Make(struct let initial_size = 16 let resize_policy = Interned.Conservative let order = Interned.Natural end)() + include T + let of_string = make let opam_fn (t : t) = to_string t ^ ".opam" @@ -14,6 +16,8 @@ module Name = struct let pp fmt t = Format.pp_print_string fmt (to_string t) let t = Sexp.Of_sexp.(map string ~f:of_string) + + module Infix = Comparable.Operators(T) end diff --git a/src/package.mli b/src/package.mli index bc64323b..35ee0768 100644 --- a/src/package.mli +++ b/src/package.mli @@ -14,6 +14,8 @@ module Name : sig include Interned.S with type t := t val t : t Sexp.Of_sexp.t + + module Infix : Comparable.OPS with type t = t end type t = diff --git a/src/preprocessing.ml b/src/preprocessing.ml index 0087d5f4..c2dd73bd 100644 --- a/src/preprocessing.ml +++ b/src/preprocessing.ml @@ -346,6 +346,7 @@ let ppx_driver_exe sctx libs ~dir_kind = | Private scope_name -> Some scope_name | Public _ | Installed -> None in + let open Dune_project.Name.Infix in match acc, scope_for_key with | Some a, Some b -> assert (a = b); acc | Some _, None -> acc