diff --git a/src/stdune/hashtbl.ml b/src/stdune/hashtbl.ml index abadd237..3e8c41e5 100644 --- a/src/stdune/hashtbl.ml +++ b/src/stdune/hashtbl.ml @@ -37,6 +37,24 @@ module Make(H : Hashable.S) = struct fold t ~init ~f:(fun ~key ~data acc -> f key data acc) let fold t ~init ~f = foldi t ~init ~f:(fun _ x -> f x) end + + let of_list l = + let h = create (List.length l) in + let rec loop = function + | [] -> Result.Ok h + | (k, v) :: xs -> + begin match find h k with + | None -> add h k v; loop xs + | Some v' -> Error (k, v', v) + end + in + loop l + + let of_list_exn l = + match of_list l with + | Result.Ok h -> h + | Error (_, _, _) -> + Exn.code_error "Hashtbl.of_list_exn duplicate keys" [] end open MoreLabels.Hashtbl diff --git a/src/stdune/hashtbl_intf.ml b/src/stdune/hashtbl_intf.ml index 3d30d0e1..c09d8d27 100644 --- a/src/stdune/hashtbl_intf.ml +++ b/src/stdune/hashtbl_intf.ml @@ -8,4 +8,6 @@ module type S = sig val fold : 'a t -> init:'b -> f:('a -> 'b -> 'b) -> 'b val foldi : 'a t -> init:'b -> f:(key -> 'a -> 'b -> 'b) -> 'b + + val of_list_exn : (key * 'a) list -> 'a t end diff --git a/src/stdune/string.ml b/src/stdune/string.ml index bc7e87f9..3bb7f50e 100644 --- a/src/stdune/string.ml +++ b/src/stdune/string.ml @@ -16,6 +16,8 @@ let compare a b = Ordering.of_int (String.compare a b) module T = struct type t = StringLabels.t let compare = compare + let equal (x : t) (y : t) = x = y + let hash (s : t) = Hashtbl.hash s end let capitalize = capitalize_ascii @@ -201,6 +203,7 @@ let maybe_quoted s = module Set = Set.Make(T) module Map = Map.Make(T) +module Table = Hashtbl.Make(T) let enumerate_gen s = let s = " " ^ s ^ " " in diff --git a/src/stdune/string.mli b/src/stdune/string.mli index a2c9d982..54818776 100644 --- a/src/stdune/string.mli +++ b/src/stdune/string.mli @@ -53,3 +53,4 @@ val enumerate_or : string list -> string module Set : Set.S with type elt = t module Map : Map.S with type key = t +module Table : Hashtbl.S with type key = t diff --git a/src/super_context.ml b/src/super_context.ml index 1cbf8206..e32cfa07 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -122,7 +122,7 @@ end = struct | Renamed_in of Syntax.Version.t * string module Map = struct - type nonrec 'a t = 'a t String.Map.t + type nonrec 'a t = 'a t String.Table.t let values v = Nothing (Kind.Values v) let renamed_in ~new_name ~version = Renamed_in (version, new_name) @@ -161,7 +161,7 @@ end = struct ; "path-no-dep", deleted_in ~version:(1, 0) Path_no_dep ] - |> String.Map.of_list_exn + |> String.Table.of_list_exn let create_vars ~(context : Context.t) ~cxx_flags = let ocamlopt = @@ -226,9 +226,9 @@ end = struct ; vars ] |> List.concat - |> String.Map.of_list_exn + |> String.Table.of_list_exn - let static_vars = String.Map.of_list_exn static_vars + let static_vars = String.Table.of_list_exn static_vars let rec expand t ~syntax_version ~var = let name = @@ -236,7 +236,7 @@ end = struct | Single v -> v | Pair (v, _) -> v in - Option.bind (String.Map.find t name) ~f:(function + Option.bind (String.Table.find t name) ~f:(function | Nothing v -> Some v | Since (v, min_version) -> if syntax_version >= min_version then