Add comparison functions for names

Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
Etienne Millon 2018-08-06 08:27:54 +00:00
parent 8306f261e7
commit 0ec9baf257
10 changed files with 44 additions and 13 deletions

View File

@ -1475,6 +1475,7 @@ let package_deps t pkg files =
else else
List.fold_left pkgs ~init:acc ~f:add_package List.fold_left pkgs ~init:acc ~f:add_package
and add_package acc p = and add_package acc p =
let open Package.Name.Infix in
if p = pkg then if p = pkg then
acc acc
else else

View File

@ -175,6 +175,7 @@ module Library_modules = struct
if not lib.wrapped then if not lib.wrapped then
modules modules
else else
let open Module.Name.Infix in
Module.Name.Map.map modules ~f:(fun m -> Module.Name.Map.map modules ~f:(fun m ->
if m.name = main_module_name then if m.name = main_module_name then
m 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 match Module.Name.Map.of_list rev_modules with
| Ok x -> x | Ok x -> x
| Error (name, _, _) -> | Error (name, _, _) ->
let open Module.Name.Infix in
let locs = let locs =
List.filter_map rev_modules ~f:(fun (n, b) -> List.filter_map rev_modules ~f:(fun (n, b) ->
Option.some_if (n = name) b.loc) Option.some_if (n = name) b.loc)

View File

@ -32,20 +32,28 @@ module Name : sig
val named : string -> t option val named : string -> t option
val anonymous_root : t val anonymous_root : t
module Infix : Comparable.OPS with type t = t
end = struct end = struct
type t = module T = struct
| Named of string type t =
| Anonymous of Path.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 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 let to_string_hum = function
| Named s -> s | Named s -> s
| Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p) | Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
@ -305,6 +313,7 @@ let default_name ~dir ~packages =
| None -> Option.value_exn (Name.anonymous dir) | None -> Option.value_exn (Name.anonymous dir)
| Some (_, pkg) -> | Some (_, pkg) ->
let pkg = let pkg =
let open Package.Name.Infix in
Package.Name.Map.fold packages ~init:pkg ~f:(fun pkg acc -> Package.Name.Map.fold packages ~init:pkg ~f:(fun pkg acc ->
if acc.Package.name <= pkg.Package.name then if acc.Package.name <= pkg.Package.name then
acc acc

View File

@ -27,6 +27,8 @@ module Name : sig
(** Convert to/from an encoded string that is suitable to use in filenames *) (** Convert to/from an encoded string that is suitable to use in filenames *)
val encode : t -> string val encode : t -> string
val decode : string -> t val decode : string -> t
module Infix : Comparable.OPS with type t = t
end end
module Project_file : sig module Project_file : sig

View File

@ -1,13 +1,17 @@
open Import open Import
module Name = struct module Name = struct
type t = string module T = struct
type t = string
let compare = compare
end
include T
let t = Sexp.atom let t = Sexp.atom
let add_suffix = (^) let add_suffix = (^)
let compare = compare
let of_string = String.capitalize let of_string = String.capitalize
let to_string x = x let to_string x = x
@ -19,6 +23,7 @@ module Name = struct
module Set = String.Set module Set = String.Set
module Map = String.Map module Map = String.Map
module Top_closure = Top_closure.String module Top_closure = Top_closure.String
module Infix = Comparable.Operators(T)
end end
module Syntax = struct module Syntax = struct

View File

@ -19,6 +19,8 @@ module Name : sig
module Map : Map.S with type key = t module Map : Map.S with type key = t
module Top_closure : Top_closure.S with type key := t module Top_closure : Top_closure.S with type key := t
module Infix : Comparable.OPS with type t = t
end end
module Syntax : sig module Syntax : sig

View File

@ -60,6 +60,7 @@ module Dep_graphs = struct
end end
let parse_module_names ~(unit : Module.t) ~modules words = let parse_module_names ~(unit : Module.t) ~modules words =
let open Module.Name.Infix in
List.filter_map words ~f:(fun m -> List.filter_map words ~f:(fun m ->
let m = Module.Name.of_string m in let m = Module.Name.of_string m in
if m = unit.name then if m = unit.name then
@ -68,6 +69,7 @@ let parse_module_names ~(unit : Module.t) ~modules words =
Module.Name.Map.find modules m) Module.Name.Map.find modules m)
let is_alias_module cctx (m : Module.t) = let is_alias_module cctx (m : Module.t) =
let open Module.Name.Infix in
match CC.alias_module cctx with match CC.alias_module cctx with
| None -> false | None -> false
| Some alias -> alias.name = m.name | Some alias -> alias.name = m.name
@ -103,6 +105,7 @@ let parse_deps cctx ~file ~unit lines =
(match lib_interface_module with (match lib_interface_module with
| None -> () | None -> ()
| Some (m : Module.t) -> | Some (m : Module.t) ->
let open Module.Name.Infix in
if unit.name <> m.name && not (is_alias_module cctx unit) && if unit.name <> m.name && not (is_alias_module cctx unit) &&
List.exists deps ~f:(fun x -> Module.name x = m.name) then List.exists deps ~f:(fun x -> Module.name x = m.name) then
die "Module %a in directory %s depends on %a.\n\ die "Module %a in directory %s depends on %a.\n\

View File

@ -1,12 +1,14 @@
open Stdune open Stdune
module Name = struct module Name = struct
include Interned.Make(struct module T = Interned.Make(struct
let initial_size = 16 let initial_size = 16
let resize_policy = Interned.Conservative let resize_policy = Interned.Conservative
let order = Interned.Natural let order = Interned.Natural
end)() end)()
include T
let of_string = make let of_string = make
let opam_fn (t : t) = to_string t ^ ".opam" 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 pp fmt t = Format.pp_print_string fmt (to_string t)
let t = Sexp.Of_sexp.(map string ~f:of_string) let t = Sexp.Of_sexp.(map string ~f:of_string)
module Infix = Comparable.Operators(T)
end end

View File

@ -14,6 +14,8 @@ module Name : sig
include Interned.S with type t := t include Interned.S with type t := t
val t : t Sexp.Of_sexp.t val t : t Sexp.Of_sexp.t
module Infix : Comparable.OPS with type t = t
end end
type t = type t =

View File

@ -346,6 +346,7 @@ let ppx_driver_exe sctx libs ~dir_kind =
| Private scope_name -> Some scope_name | Private scope_name -> Some scope_name
| Public _ | Installed -> None | Public _ | Installed -> None
in in
let open Dune_project.Name.Infix in
match acc, scope_for_key with match acc, scope_for_key with
| Some a, Some b -> assert (a = b); acc | Some a, Some b -> assert (a = b); acc
| Some _, None -> acc | Some _, None -> acc