diff --git a/sledge/nonstdlib/NSMap.ml b/sledge/nonstdlib/NSMap.ml index de0f426e9..6abcf14fb 100644 --- a/sledge/nonstdlib/NSMap.ml +++ b/sledge/nonstdlib/NSMap.ml @@ -11,13 +11,16 @@ include NSMap_intf module Make (Key : sig type t [@@deriving compare, sexp_of] end) : S with type key = Key.t = struct - module M = CCMap.Make (Key) + module M = Stdlib.Map.Make (Key) type key = Key.t type 'a t = 'a M.t [@@deriving compare, equal] + let to_list = M.bindings + let of_list l = List.fold_left l M.empty ~f:(fun m (k, v) -> M.add k v m) + let sexp_of_t sexp_of_data m = - M.to_list m + to_list m |> Sexplib.Conv.sexp_of_list (Sexplib.Conv.sexp_of_pair Key.sexp_of_t sexp_of_data) @@ -29,7 +32,7 @@ end) : S with type key = Key.t = struct s |> Sexplib.Conv.list_of_sexp (Sexplib.Conv.pair_of_sexp Key.t_of_sexp data_of_sexp) - |> M.of_list + |> of_list end let empty = M.empty @@ -47,12 +50,21 @@ end) : S with type key = Key.t = struct m let remove key m = M.remove key m - let merge l r ~f = M.merge_safe l r ~f - let merge_endo t u ~f = + let merge l r ~f = + let combine k lo ro = + match (lo, ro) with + | Some lv, Some rv -> f k (`Both (lv, rv)) + | Some lv, None -> f k (`Left lv) + | None, Some rv -> f k (`Right rv) + | None, None -> None + in + M.merge combine l r + + let merge_endo l r ~f = let change = ref false in - let t' = - merge t u ~f:(fun key side -> + let l' = + merge l r ~f:(fun key side -> let f_side = f key side in ( match (side, f_side) with | (`Both (data, _) | `Left data), Some data' when data' == data -> @@ -60,7 +72,7 @@ end) : S with type key = Key.t = struct | _ -> change := true ) ; f_side ) in - if !change then t' else t + if !change then l' else l let union x y ~f = M.union f x y @@ -198,30 +210,24 @@ end) : S with type key = Key.t = struct let existsi m ~f = M.exists (fun key data -> f ~key ~data) m let for_alli m ~f = M.for_all (fun key data -> f ~key ~data) m let fold m s ~f = M.fold (fun key data acc -> f ~key ~data acc) m s - let keys = M.keys - let values = M.values - let to_iter = M.to_iter - let to_list = M.bindings - let to_list_rev = M.to_list - let of_iter = M.of_iter - let of_list = M.of_list + let to_iter m = Iter.from_iter (fun f -> M.iter (fun k v -> f (k, v)) m) + let keys m = Iter.from_iter (fun f -> M.iter (fun k _ -> f k) m) + let values m = Iter.from_iter (fun f -> M.iter (fun _ v -> f v) m) + let of_iter s = Iter.fold s M.empty ~f:(fun (k, v) m -> M.add k v m) - let to_iter2 l r = + let symmetric_diff l r ~eq = let seq = ref Iter.empty in - M.merge_safe l r ~f:(fun k vv -> - seq := Iter.cons (k, vv) !seq ; + let yield x = seq := Iter.cons x !seq in + merge l r ~f:(fun k vv -> + ( match vv with + | `Both (lv, rv) when eq lv rv -> () + | `Both vv -> yield (k, `Unequal vv) + | `Left lv -> yield (k, `Left lv) + | `Right rv -> yield (k, `Right rv) ) ; None ) |> ignore ; !seq - let symmetric_diff l r ~eq = - Iter.filter_map (to_iter2 l r) ~f:(fun (k, vv) -> - match vv with - | `Both (lv, rv) when eq lv rv -> None - | `Both vv -> Some (k, `Unequal vv) - | `Left lv -> Some (k, `Left lv) - | `Right rv -> Some (k, `Right rv) ) - let pp pp_k pp_v fs m = Format.fprintf fs "@[<1>[%a]@]" (List.pp ",@ " (fun fs (k, v) -> diff --git a/sledge/nonstdlib/NSMap_intf.ml b/sledge/nonstdlib/NSMap_intf.ml index 534afd082..856bd8c0c 100644 --- a/sledge/nonstdlib/NSMap_intf.ml +++ b/sledge/nonstdlib/NSMap_intf.ml @@ -126,15 +126,9 @@ module type S = sig val values : 'a t -> 'a iter val to_iter : 'a t -> (key * 'a) iter val to_list : 'a t -> (key * 'a) list - val to_list_rev : 'a t -> (key * 'a) list val of_iter : (key * 'a) iter -> 'a t val of_list : (key * 'a) list -> 'a t - val to_iter2 : - 'a t - -> 'b t - -> (key * [`Left of 'a | `Both of 'a * 'b | `Right of 'b]) iter - val symmetric_diff : 'a t -> 'b t diff --git a/sledge/nonstdlib/NSSet.ml b/sledge/nonstdlib/NSSet.ml index 89a57cd16..47e699f0f 100644 --- a/sledge/nonstdlib/NSSet.ml +++ b/sledge/nonstdlib/NSSet.ml @@ -11,7 +11,7 @@ include NSSet_intf module Make (Elt : sig type t [@@deriving compare, sexp_of] end) : S with type elt = Elt.t = struct - module S = CCSet.Make (Elt) + module S = Stdlib.Set.Make (Elt) type elt = Elt.t type t = S.t [@@deriving compare, equal] @@ -34,7 +34,8 @@ end) : S with type elt = Elt.t = struct let hash = Hash.of_fold hash_fold_t end - let sexp_of_t s = S.to_list s |> Sexplib.Conv.sexp_of_list Elt.sexp_of_t + let to_list = S.elements + let sexp_of_t s = to_list s |> Sexplib.Conv.sexp_of_list Elt.sexp_of_t module Provide_of_sexp (Elt : sig type t = elt [@@deriving of_sexp] @@ -50,7 +51,7 @@ end) : S with type elt = Elt.t = struct let of_list = S.of_list let add x s = S.add x s let add_option = Option.fold ~f:add - let add_list xs s = S.add_list s xs + let add_list xs s = S.union (S.of_list xs) s let remove x s = S.remove x s let diff = S.diff let inter = S.inter @@ -117,8 +118,8 @@ end) : S with type elt = Elt.t = struct let reduce xs ~f = match pop xs with Some (x, xs) -> Some (fold ~f xs x) | None -> None - let to_iter = S.to_iter - let of_iter = S.of_iter + let to_iter s = Iter.from_iter (fun f -> S.iter f s) + let of_iter s = Iter.fold ~f:add s S.empty let pp_full ?pre ?suf ?(sep = (",@ " : (unit, unit) fmt)) pp_elt fs x = List.pp ?pre ?suf sep pp_elt fs (S.elements x)