diff --git a/sledge/lib/import/import.ml b/sledge/lib/import/import.ml index e39d82d21..9e8f563e2 100644 --- a/sledge/lib/import/import.ml +++ b/sledge/lib/import/import.ml @@ -15,6 +15,7 @@ include ( with module Option := Base.Option and module List := Base.List and module Set := Base.Set + and module Map := Base.Map (* prematurely deprecated, remove and use Stdlib instead *) and module Filename := Base.Filename and module Format := Base.Format @@ -118,198 +119,8 @@ include Option.Monad_syntax module List = List module Vector = Vector include Vector.Infix - -exception Duplicate - module Set = Set - -module Map = struct - module type S = sig - type key - type +'a t - - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t - val t_of_sexp : (Sexp.t -> key) -> (Sexp.t -> 'a) -> Sexp.t -> 'a t - val pp : key pp -> 'a pp -> 'a t pp - - val pp_diff : - data_equal:('a -> 'a -> bool) - -> key pp - -> 'a pp - -> ('a * 'a) pp - -> ('a t * 'a t) pp - - (* initial constructors *) - val empty : 'a t - - (* constructors *) - val set : 'a t -> key:key -> data:'a -> 'a t - val add_exn : 'a t -> key:key -> data:'a -> 'a t - val add_multi : 'a list t -> key:key -> data:'a -> 'a list t - val remove : 'a t -> key -> 'a t - val update : 'a t -> key -> f:('a option -> 'a) -> 'a t - - val merge : - 'a t - -> 'b t - -> f: - ( key:key - -> [`Both of 'a * 'b | `Left of 'a | `Right of 'b] - -> 'c option) - -> 'c t - - val merge_skewed : - 'a t -> 'a t -> combine:(key:key -> 'a -> 'a -> 'a) -> 'a t - - val map : 'a t -> f:('a -> 'b) -> 'b t - val filter_keys : 'a t -> f:(key -> bool) -> 'a t - val filter_mapi : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t - - (* queries *) - val is_empty : 'b t -> bool - val length : 'b t -> int - val mem : 'a t -> key -> bool - val find : 'a t -> key -> 'a option - val find_and_remove : 'a t -> key -> ('a * 'a t) option - val find_multi : 'a list t -> key -> 'a list - val data : 'a t -> 'a list - val to_alist : 'a t -> (key * 'a) list - - (* traversals *) - val iter : 'a t -> f:('a -> unit) -> unit - val iteri : 'a t -> f:(key:key -> data:'a -> unit) -> unit - val for_alli : 'a t -> f:(key:key -> data:'a -> bool) -> bool - val fold : 'a t -> init:'s -> f:(key:key -> data:'a -> 's -> 's) -> 's - end - - module Make (Key : OrderedType) : S with type key = Key.t = struct - module M = Caml.Map.Make (Key) - - type key = Key.t - type 'a t = 'a M.t - - let compare = M.compare - let equal = M.equal - - let sexp_of_t sexp_of_val m = - List.sexp_of_t - (Sexplib.Conv.sexp_of_pair Key.sexp_of_t sexp_of_val) - (M.bindings m) - - let t_of_sexp key_of_sexp val_of_sexp sexp = - Caml.List.fold_left - (fun m (k, v) -> M.add k v m) - M.empty - (List.t_of_sexp - (Sexplib.Conv.pair_of_sexp key_of_sexp val_of_sexp) - sexp) - - let pp pp_k pp_v fs m = - Format.fprintf fs "@[<1>[%a]@]" - (List.pp ",@ " (fun fs (k, v) -> - Format.fprintf fs "@[%a @<2>↦ %a@]" pp_k k pp_v v )) - (M.bindings m) - - let pp_diff ~data_equal pp_key pp_val pp_diff_val fs (x, y) = - let pp_diff_val fs = function - | k, `Left v -> - Format.fprintf fs "-- [@[%a@ @<2>↦ %a@]]" pp_key k pp_val v - | k, `Right v -> - Format.fprintf fs "++ [@[%a@ @<2>↦ %a@]]" pp_key k pp_val v - | k, `Unequal vv -> - Format.fprintf fs "[@[%a@ @<2>↦ %a@]]" pp_key k pp_diff_val vv - in - let sd = - M.merge - (fun _ v1o v2o -> - match (v1o, v2o) with - | Some v1, Some v2 when not (data_equal v1 v2) -> - Some (`Unequal (v1, v2)) - | Some v1, None -> Some (`Left v1) - | None, Some v2 -> Some (`Right v2) - | _ -> None ) - x y - in - if not (M.is_empty sd) then - Format.fprintf fs "[@[%a@]];@ " - (List.pp ";@ " pp_diff_val) - (M.bindings sd) - - exception Duplicate - - let empty = M.empty - let set m ~key ~data = M.add key data m - - let add_exn m ~key ~data = - M.update key - (function None -> Some data | Some _ -> raise Duplicate) - m - - let add_multi m ~key ~data = - M.update key - (function None -> Some [data] | Some vs -> Some (data :: vs)) - m - - let remove m k = M.remove k m - let update m k ~f = M.update k (fun vo -> Some (f vo)) m - - let merge m n ~f = - M.merge - (fun k v1o v2o -> - match (v1o, v2o) with - | Some v1, Some v2 -> f ~key:k (`Both (v1, v2)) - | Some v1, None -> f ~key:k (`Left v1) - | None, Some v2 -> f ~key:k (`Right v2) - | None, None -> None ) - m n - - let merge_skewed m n ~combine = - M.merge - (fun k v1o v2o -> - match (v1o, v2o) with - | Some v1, Some v2 -> Some (combine ~key:k v1 v2) - | Some _, None -> v1o - | None, Some _ -> v2o - | None, None -> None ) - m n - - let map m ~f = M.map f m - let filter_keys m ~f = M.filter (fun k _ -> f k) m - - let filter_mapi m ~f = - M.fold - (fun k v m -> - match f ~key:k ~data:v with Some v' -> M.add k v' m | None -> m ) - m M.empty - - let is_empty = M.is_empty - let length = M.cardinal - let mem m k = M.mem k m - let find m k = M.find_opt k m - - let find_and_remove m k = - let found = ref None in - let m = - M.update k - (fun v -> - found := v ; - None ) - m - in - let+ v = !found in - (v, m) - - let find_multi m k = try M.find k m with Not_found -> [] - let data m = M.fold (fun _ v s -> v :: s) m [] - let to_alist = M.bindings - let iter m ~f = M.iter (fun _ v -> f v) m - let iteri m ~f = M.iter (fun k v -> f ~key:k ~data:v) m - let for_alli m ~f = M.for_all (fun key data -> f ~key ~data) m - let fold m ~init ~f = M.fold (fun key data s -> f ~key ~data s) m init - end -end +module Map = Map module Qset = struct include Qset diff --git a/sledge/lib/import/import.mli b/sledge/lib/import/import.mli index e105c84d6..cef8f6339 100644 --- a/sledge/lib/import/import.mli +++ b/sledge/lib/import/import.mli @@ -15,6 +15,7 @@ include module type of ( with module Option := Base.Option and module List := Base.List and module Set := Base.Set + and module Map := Base.Map (* prematurely deprecated, remove and use Stdlib instead *) and module Filename := Base.Filename and module Format := Base.Format @@ -111,74 +112,8 @@ include module type of Option.Monad_syntax with type 'a t = 'a option module List = List module Vector = Vector include module type of Vector.Infix - -exception Duplicate - module Set = Set - -module Map : sig - module type S = sig - type key - type +'a t - - val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int - val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool - val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t - val t_of_sexp : (Sexp.t -> key) -> (Sexp.t -> 'a) -> Sexp.t -> 'a t - val pp : key pp -> 'a pp -> 'a t pp - - val pp_diff : - data_equal:('a -> 'a -> bool) - -> key pp - -> 'a pp - -> ('a * 'a) pp - -> ('a t * 'a t) pp - - (* initial constructors *) - val empty : 'a t - - (* constructors *) - val set : 'a t -> key:key -> data:'a -> 'a t - val add_exn : 'a t -> key:key -> data:'a -> 'a t - val add_multi : 'a list t -> key:key -> data:'a -> 'a list t - val remove : 'a t -> key -> 'a t - val update : 'a t -> key -> f:('a option -> 'a) -> 'a t - - val merge : - 'a t - -> 'b t - -> f: - ( key:key - -> [`Both of 'a * 'b | `Left of 'a | `Right of 'b] - -> 'c option) - -> 'c t - - val merge_skewed : - 'a t -> 'a t -> combine:(key:key -> 'a -> 'a -> 'a) -> 'a t - - val map : 'a t -> f:('a -> 'b) -> 'b t - val filter_keys : 'a t -> f:(key -> bool) -> 'a t - val filter_mapi : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t - - (* queries *) - val is_empty : 'b t -> bool - val length : 'b t -> int - val mem : 'a t -> key -> bool - val find : 'a t -> key -> 'a option - val find_and_remove : 'a t -> key -> ('a * 'a t) option - val find_multi : 'a list t -> key -> 'a list - val data : 'a t -> 'a list - val to_alist : 'a t -> (key * 'a) list - - (* traversals *) - val iter : 'a t -> f:('a -> unit) -> unit - val iteri : 'a t -> f:(key:key -> data:'a -> unit) -> unit - val for_alli : 'a t -> f:(key:key -> data:'a -> bool) -> bool - val fold : 'a t -> init:'s -> f:(key:key -> data:'a -> 's -> 's) -> 's - end - - module Make (Key : OrderedType) : S with type key = Key.t -end +module Map = Map module Qset : sig include module type of Qset diff --git a/sledge/lib/import/import0.ml b/sledge/lib/import/import0.ml index de0481cda..1bd3a0a41 100644 --- a/sledge/lib/import/import0.ml +++ b/sledge/lib/import/import0.ml @@ -33,3 +33,5 @@ module type OrderedType = sig val compare : t -> t -> int val sexp_of_t : t -> Sexp.t end + +exception Duplicate diff --git a/sledge/lib/import/map.ml b/sledge/lib/import/map.ml new file mode 100644 index 000000000..415b00fb6 --- /dev/null +++ b/sledge/lib/import/map.ml @@ -0,0 +1,191 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Import0 + +module type S = sig + type key + type +'a t + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t + val t_of_sexp : (Sexp.t -> key) -> (Sexp.t -> 'a) -> Sexp.t -> 'a t + val pp : key pp -> 'a pp -> 'a t pp + + val pp_diff : + data_equal:('a -> 'a -> bool) + -> key pp + -> 'a pp + -> ('a * 'a) pp + -> ('a t * 'a t) pp + + (* initial constructors *) + val empty : 'a t + + (* constructors *) + val set : 'a t -> key:key -> data:'a -> 'a t + val add_exn : 'a t -> key:key -> data:'a -> 'a t + val add_multi : 'a list t -> key:key -> data:'a -> 'a list t + val remove : 'a t -> key -> 'a t + val update : 'a t -> key -> f:('a option -> 'a) -> 'a t + + val merge : + 'a t + -> 'b t + -> f: + ( key:key + -> [`Both of 'a * 'b | `Left of 'a | `Right of 'b] + -> 'c option) + -> 'c t + + val merge_skewed : + 'a t -> 'a t -> combine:(key:key -> 'a -> 'a -> 'a) -> 'a t + + val map : 'a t -> f:('a -> 'b) -> 'b t + val filter_keys : 'a t -> f:(key -> bool) -> 'a t + val filter_mapi : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t + + (* queries *) + val is_empty : 'b t -> bool + val length : 'b t -> int + val mem : 'a t -> key -> bool + val find : 'a t -> key -> 'a option + val find_and_remove : 'a t -> key -> ('a * 'a t) option + val find_multi : 'a list t -> key -> 'a list + val data : 'a t -> 'a list + val to_alist : 'a t -> (key * 'a) list + + (* traversals *) + val iter : 'a t -> f:('a -> unit) -> unit + val iteri : 'a t -> f:(key:key -> data:'a -> unit) -> unit + val for_alli : 'a t -> f:(key:key -> data:'a -> bool) -> bool + val fold : 'a t -> init:'s -> f:(key:key -> data:'a -> 's -> 's) -> 's +end + +module Make (Key : OrderedType) : S with type key = Key.t = struct + module M = Stdlib.Map.Make (Key) + + type key = Key.t + type 'a t = 'a M.t + + let compare = M.compare + let equal = M.equal + + let sexp_of_t sexp_of_val m = + List.sexp_of_t + (Sexplib.Conv.sexp_of_pair Key.sexp_of_t sexp_of_val) + (M.bindings m) + + let t_of_sexp key_of_sexp val_of_sexp sexp = + List.fold_left + ~f:(fun m (k, v) -> M.add k v m) + ~init:M.empty + (List.t_of_sexp + (Sexplib.Conv.pair_of_sexp key_of_sexp val_of_sexp) + sexp) + + let pp pp_k pp_v fs m = + Format.fprintf fs "@[<1>[%a]@]" + (List.pp ",@ " (fun fs (k, v) -> + Format.fprintf fs "@[%a @<2>↦ %a@]" pp_k k pp_v v )) + (M.bindings m) + + let pp_diff ~data_equal pp_key pp_val pp_diff_val fs (x, y) = + let pp_diff_val fs = function + | k, `Left v -> + Format.fprintf fs "-- [@[%a@ @<2>↦ %a@]]" pp_key k pp_val v + | k, `Right v -> + Format.fprintf fs "++ [@[%a@ @<2>↦ %a@]]" pp_key k pp_val v + | k, `Unequal vv -> + Format.fprintf fs "[@[%a@ @<2>↦ %a@]]" pp_key k pp_diff_val vv + in + let sd = + M.merge + (fun _ v1o v2o -> + match (v1o, v2o) with + | Some v1, Some v2 when not (data_equal v1 v2) -> + Some (`Unequal (v1, v2)) + | Some v1, None -> Some (`Left v1) + | None, Some v2 -> Some (`Right v2) + | _ -> None ) + x y + in + if not (M.is_empty sd) then + Format.fprintf fs "[@[%a@]];@ " + (List.pp ";@ " pp_diff_val) + (M.bindings sd) + + let empty = M.empty + let set m ~key ~data = M.add key data m + + let add_exn m ~key ~data = + M.update key + (function None -> Some data | Some _ -> raise Duplicate) + m + + let add_multi m ~key ~data = + M.update key + (function None -> Some [data] | Some vs -> Some (data :: vs)) + m + + let remove m k = M.remove k m + let update m k ~f = M.update k (fun vo -> Some (f vo)) m + + let merge m n ~f = + M.merge + (fun k v1o v2o -> + match (v1o, v2o) with + | Some v1, Some v2 -> f ~key:k (`Both (v1, v2)) + | Some v1, None -> f ~key:k (`Left v1) + | None, Some v2 -> f ~key:k (`Right v2) + | None, None -> None ) + m n + + let merge_skewed m n ~combine = + M.merge + (fun k v1o v2o -> + match (v1o, v2o) with + | Some v1, Some v2 -> Some (combine ~key:k v1 v2) + | Some _, None -> v1o + | None, Some _ -> v2o + | None, None -> None ) + m n + + let map m ~f = M.map f m + let filter_keys m ~f = M.filter (fun k _ -> f k) m + + let filter_mapi m ~f = + M.fold + (fun k v m -> + match f ~key:k ~data:v with Some v' -> M.add k v' m | None -> m ) + m M.empty + + let is_empty = M.is_empty + let length = M.cardinal + let mem m k = M.mem k m + let find m k = M.find_opt k m + + let find_and_remove m k = + let found = ref None in + let m = + M.update k + (fun v -> + found := v ; + None ) + m + in + Option.map ~f:(fun v -> (v, m)) !found + + let find_multi m k = try M.find k m with Not_found -> [] + let data m = M.fold (fun _ v s -> v :: s) m [] + let to_alist = M.bindings + let iter m ~f = M.iter (fun _ v -> f v) m + let iteri m ~f = M.iter (fun k v -> f ~key:k ~data:v) m + let for_alli m ~f = M.for_all (fun key data -> f ~key ~data) m + let fold m ~init ~f = M.fold (fun key data s -> f ~key ~data s) m init +end diff --git a/sledge/lib/import/map.mli b/sledge/lib/import/map.mli new file mode 100644 index 000000000..a64666233 --- /dev/null +++ b/sledge/lib/import/map.mli @@ -0,0 +1,70 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open Import0 + +module type S = sig + type key + type +'a t + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + val sexp_of_t : ('a -> Sexp.t) -> 'a t -> Sexp.t + val t_of_sexp : (Sexp.t -> key) -> (Sexp.t -> 'a) -> Sexp.t -> 'a t + val pp : key pp -> 'a pp -> 'a t pp + + val pp_diff : + data_equal:('a -> 'a -> bool) + -> key pp + -> 'a pp + -> ('a * 'a) pp + -> ('a t * 'a t) pp + + (* initial constructors *) + val empty : 'a t + + (* constructors *) + val set : 'a t -> key:key -> data:'a -> 'a t + val add_exn : 'a t -> key:key -> data:'a -> 'a t + val add_multi : 'a list t -> key:key -> data:'a -> 'a list t + val remove : 'a t -> key -> 'a t + val update : 'a t -> key -> f:('a option -> 'a) -> 'a t + + val merge : + 'a t + -> 'b t + -> f: + ( key:key + -> [`Both of 'a * 'b | `Left of 'a | `Right of 'b] + -> 'c option) + -> 'c t + + val merge_skewed : + 'a t -> 'a t -> combine:(key:key -> 'a -> 'a -> 'a) -> 'a t + + val map : 'a t -> f:('a -> 'b) -> 'b t + val filter_keys : 'a t -> f:(key -> bool) -> 'a t + val filter_mapi : 'a t -> f:(key:key -> data:'a -> 'b option) -> 'b t + + (* queries *) + val is_empty : 'b t -> bool + val length : 'b t -> int + val mem : 'a t -> key -> bool + val find : 'a t -> key -> 'a option + val find_and_remove : 'a t -> key -> ('a * 'a t) option + val find_multi : 'a list t -> key -> 'a list + val data : 'a t -> 'a list + val to_alist : 'a t -> (key * 'a) list + + (* traversals *) + val iter : 'a t -> f:('a -> unit) -> unit + val iteri : 'a t -> f:(key:key -> data:'a -> unit) -> unit + val for_alli : 'a t -> f:(key:key -> data:'a -> bool) -> bool + val fold : 'a t -> init:'s -> f:(key:key -> data:'a -> 's -> 's) -> 's +end + +module Make (Key : OrderedType) : S with type key = Key.t