From cbe687273154d0cc15076917805a05a9d5af6a25 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Sun, 21 Feb 2021 13:17:33 -0800
Subject: [PATCH] [sledge] Adapt NSSet to Comparer interface

Reviewed By: jvillard

Differential Revision: D26250522

fbshipit-source-id: 3154a1694
---
 sledge/nonstdlib/NSSet.ml      | 49 +++++++++++++++++++++++-----------
 sledge/nonstdlib/NSSet.mli     | 16 ++++++++++-
 sledge/nonstdlib/NSSet_intf.ml |  7 ++---
 sledge/src/control.ml          |  4 +--
 4 files changed, 54 insertions(+), 22 deletions(-)

diff --git a/sledge/nonstdlib/NSSet.ml b/sledge/nonstdlib/NSSet.ml
index e75fd1230..4aa0ea305 100644
--- a/sledge/nonstdlib/NSSet.ml
+++ b/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]
diff --git a/sledge/nonstdlib/NSSet.mli b/sledge/nonstdlib/NSSet.mli
index 24e0e8852..88546a8f4 100644
--- a/sledge/nonstdlib/NSSet.mli
+++ b/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
diff --git a/sledge/nonstdlib/NSSet_intf.ml b/sledge/nonstdlib/NSSet_intf.ml
index 3dae44b13..1696b725b 100644
--- a/sledge/nonstdlib/NSSet_intf.ml
+++ b/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
diff --git a/sledge/src/control.ml b/sledge/src/control.ml
index 1a197214f..84027a0d2 100644
--- a/sledge/src/control.ml
+++ b/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