Add comparison functions for names
Signed-off-by: Etienne Millon <me@emillon.org>
This commit is contained in:
parent
8306f261e7
commit
0ec9baf257
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -32,19 +32,27 @@ 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
|
||||||
|
module T = struct
|
||||||
type t =
|
type t =
|
||||||
| Named of string
|
| Named of string
|
||||||
| Anonymous of Path.t
|
| Anonymous of Path.t
|
||||||
|
|
||||||
let anonymous_root = Anonymous Path.root
|
|
||||||
|
|
||||||
let compare a b =
|
let compare a b =
|
||||||
match a, b with
|
match a, b with
|
||||||
| Named x, Named y -> String.compare x y
|
| Named x, Named y -> String.compare x y
|
||||||
| Anonymous x, Anonymous y -> Path.compare x y
|
| Anonymous x, Anonymous y -> Path.compare x y
|
||||||
| Named _, Anonymous _ -> Lt
|
| Named _, Anonymous _ -> Lt
|
||||||
| Anonymous _, Named _ -> Gt
|
| Anonymous _, Named _ -> Gt
|
||||||
|
end
|
||||||
|
|
||||||
|
include T
|
||||||
|
|
||||||
|
module Infix = Comparable.Operators(T)
|
||||||
|
|
||||||
|
let anonymous_root = Anonymous Path.root
|
||||||
|
|
||||||
let to_string_hum = function
|
let to_string_hum = function
|
||||||
| Named s -> s
|
| Named s -> s
|
||||||
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,13 +1,17 @@
|
||||||
open Import
|
open Import
|
||||||
|
|
||||||
module Name = struct
|
module Name = struct
|
||||||
|
module T = struct
|
||||||
type t = string
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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\
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue