[sledge] Adapt NSSet to Comparer interface

Reviewed By: jvillard

Differential Revision: D26250522

fbshipit-source-id: 3154a1694

sledge/nonstdlib/NSSet.ml

@@ -8,13 +8,28 @@
 open! NS0
 include NSSet_intf
 
-module Make (Elt : sig
-  type t [@@deriving compare, sexp_of]
-end) : S with type elt = Elt.t = struct
-  module S = Stdlib.Set.Make [@inlined] (Elt)
+type ('elt, 'compare_elt) t = ('elt, 'compare_elt) Set.t
+[@@deriving compare, equal, sexp]
+
+type 'compare_elt compare = 'compare_elt Set.compare
+[@@deriving compare, equal, sexp]
+
+module Make_from_Comparer (Elt : sig
+  type t [@@deriving equal, sexp_of]
+
+  include Comparer.S with type t := t
+end) =
+struct
+  module S = Set.Make [@inlined] (Elt)
 
   type elt = Elt.t
-  type t = S.t [@@deriving compare, equal]
+  type compare_elt = Elt.compare
+  type t = S.t [@@deriving compare]
+  type compare = S.compare [@@deriving compare, equal, sexp]
+
+  let comparer = S.comparer
+
+  include S.Provide_equal (Elt)
 
   module Provide_hash (Elt : sig
     type t = elt [@@deriving hash]
@@ -34,21 +49,12 @@ end) : S with type elt = Elt.t = struct
     let hash = Hash.of_fold hash_fold_t
   end
 
-  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]
-  end) =
-  struct
-    let t_of_sexp s =
-      s |> Sexplib.Conv.list_of_sexp Elt.t_of_sexp |> S.of_list
-  end
+  include S.Provide_sexp_of (Elt)
+  module Provide_of_sexp = S.Provide_of_sexp
 
   let empty = S.empty
   let of_ = S.singleton
   let of_option xo = Option.map_or ~f:S.singleton xo ~default:empty
-  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.union (S.of_list xs) s
@@ -118,6 +124,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_list = S.elements
+  let of_list = S.of_list
   let to_iter s = Iter.from_iter (fun f -> S.iter f s)
   let of_iter s = Iter.fold ~f:add s S.empty
 
@@ -139,3 +147,12 @@ end) : S with type elt = Elt.t = struct
   end
 end
 [@@inline]
+
+module Make (Elt : sig
+  type t [@@deriving compare, equal, sexp_of]
+end) =
+Make_from_Comparer (struct
+  include Elt
+  include Comparer.Make (Elt)
+end)
+[@@inline]

sledge/nonstdlib/NSSet.mli

@@ -7,6 +7,20 @@
 
 include module type of NSSet_intf
 
+type ('elt, 'compare_elt) t [@@deriving compare, equal, sexp]
+type 'compare_elt compare [@@deriving compare, equal, sexp]
+
 module Make (Elt : sig
-  type t [@@deriving compare, sexp_of]
+  type t [@@deriving compare, equal, sexp_of]
 end) : S with type elt = Elt.t
+
+module Make_from_Comparer (Elt : sig
+  type t [@@deriving equal, sexp_of]
+
+  include Comparer.S with type t := t
+end) :
+  S
+    with type elt = Elt.t
+    with type compare_elt = Elt.compare
+    with type compare = Elt.compare compare
+    with type t = (Elt.t, Elt.compare) t

sledge/nonstdlib/NSSet_intf.ml

@@ -9,8 +9,11 @@ open! NS0
 
 module type S = sig
   type elt
+  type compare_elt
   type t [@@deriving compare, equal, sexp_of]
 
+  include Comparer.S with type t := t
+
   module Provide_hash (_ : sig
     type t = elt [@@deriving hash]
   end) : sig
@@ -39,12 +42,9 @@ module type S = sig
 
     val pp : t pp
   end) : sig
-    type t
-
     val pp : t pp
     val pp_diff : (t * t) pp
   end
-  with type t := t
 
   (** {1 Construct} *)
 
@@ -96,6 +96,7 @@ module type S = sig
 
   (** {1 Convert} *)
 
+  val to_list : t -> elt list
   val to_iter : t -> elt iter
   val of_iter : elt iter -> t
 end

sledge/src/control.ml

@@ -211,10 +211,10 @@ module Make (Opts : Domain_intf.Opts) (Dom : Domain_intf.Dom) = struct
           queue without the top element *)
     end = struct
       type elt = {depth: int; edge: Edge.t; state: Dom.t; depths: Depths.t}
-      [@@deriving compare, sexp_of]
+      [@@deriving compare, equal, sexp_of]
 
       module Elt = struct
-        type t = elt [@@deriving compare, sexp_of]
+        type t = elt [@@deriving compare, equal, sexp_of]
 
         let pp ppf {depth; edge} =
           Format.fprintf ppf "%i: %a" depth Edge.pp edge