Add cmp argument to some PSet functions

Every PSet function creating a new set should allow to set the comparison
function.

ChangeLog

@@ -18,6 +18,11 @@ Changelog
     val combine: 'a t -> 'b t -> ('a * 'b) t
   #578
   (François Berenger)
+- PSet: add a ?cmp argument to every function that creates a PSet:
+    of_enum, of_list, of_array
+  are changed. The default value is Pervasives.compare.
+  #679
+  (Cedric Cellier)
 
 ## v2.5.0
 

src/batSet.ml

@@ -810,10 +810,10 @@ module PSet = struct (*$< PSet *)
 
   let max_elt s = Concrete.max_elt s.set
   let enum s = Concrete.enum s.set
-  let of_enum e = { cmp = compare; set = Concrete.of_enum compare e }
+  let of_enum ?(cmp = compare) e = { cmp; set = Concrete.of_enum compare e }
   let of_enum_cmp ~cmp t = { cmp = cmp; set = Concrete.of_enum cmp t }
-  let of_list l = { cmp = compare; set = Concrete.of_list compare l }
-  let of_array a = { cmp = compare; set = Concrete.of_array compare a }
+  let of_list ?(cmp = compare) l = { cmp; set = Concrete.of_list compare l }
+  let of_array ?(cmp = compare) a = { cmp; set = Concrete.of_array compare a }
   let print ?first ?last ?sep print_elt out s =
     Concrete.print ?first ?last ?sep print_elt out s.set
   let for_all f s = Concrete.for_all f s.set

src/batSet.mli

@@ -903,17 +903,16 @@ module PSet : sig
       The returned enumeration is sorted in increasing order with respect
       to the ordering of this set.*)
 
-  val of_enum: 'a BatEnum.t -> 'a t
+  val of_enum: ?cmp:('a -> 'a -> int) -> 'a BatEnum.t -> 'a t
 
   val of_enum_cmp: cmp:('a -> 'a -> int) -> 'a BatEnum.t -> 'a t
 
-  val of_list: 'a list -> 'a t
+  val of_list: ?cmp:('a -> 'a -> int) -> 'a list -> 'a t
   (** builds a set from the given list, using the default comparison
       function *)
 
-  val of_array: 'a array -> 'a t
-  (** builds a set from the given array, using the default comparison
-      function *)
+  val of_array: ?cmp:('a -> 'a -> int) -> 'a array -> 'a t
+  (** builds a set from the given array and comparison function *)
 
   (** {6 Boilerplate code}*)