Comparable: add Make

src/lib_base/block_header.ml

@@ -48,6 +48,25 @@ type t = {
   proto: MBytes.t ;
 }
 
+include Compare.Make (struct
+    type nonrec t = t
+    let compare b1 b2 =
+      let (>>) x y = if x = 0 then y () else x in
+      let rec list compare xs ys =
+        match xs, ys with
+        | [], [] -> 0
+        | _ :: _, [] -> -1
+        | [], _ :: _ -> 1
+        | x :: xs, y :: ys ->
+            compare x y >> fun () -> list compare xs ys in
+      Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
+      compare b1.proto b2.proto >> fun () ->
+      Operation_list_list_hash.compare
+        b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
+      Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
+      list compare b1.shell.fitness b2.shell.fitness
+  end)
+
 let encoding =
   let open Data_encoding in
   conv
@@ -61,33 +80,6 @@ let pp ppf op =
   Data_encoding.Json.pp ppf
     (Data_encoding.Json.construct encoding op)
 
-let compare b1 b2 =
-  let (>>) x y = if x = 0 then y () else x in
-  let rec list compare xs ys =
-    match xs, ys with
-    | [], [] -> 0
-    | _ :: _, [] -> -1
-    | [], _ :: _ -> 1
-    | x :: xs, y :: ys ->
-        compare x y >> fun () -> list compare xs ys in
-  Block_hash.compare b1.shell.predecessor b2.shell.predecessor >> fun () ->
-  compare b1.proto b2.proto >> fun () ->
-  Operation_list_list_hash.compare
-    b1.shell.operations_hash b2.shell.operations_hash >> fun () ->
-  Time.compare b1.shell.timestamp b2.shell.timestamp >> fun () ->
-  list compare b1.shell.fitness b2.shell.fitness
-
-let equal b1 b2 = compare b1 b2 = 0
-
-let (=) = equal
-let (<>) x y = compare x y <> 0
-let (<) x y = compare x y < 0
-let (<=) x y = compare x y <= 0
-let (>=) x y = compare x y >= 0
-let (>) x y = compare x y > 0
-let min x y = if x <= y then x else y
-let max x y = if x <= y then y else x
-
 let to_bytes v = Data_encoding.Binary.to_bytes encoding v
 let of_bytes b = Data_encoding.Binary.of_bytes encoding b
 let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b

src/lib_base/fitness.ml

@@ -9,47 +9,41 @@
 
 type t = MBytes.t list
 
-(* Fitness comparison:
+include Compare.Make(struct
-   - shortest lists are smaller ;
+
-   - lexicographical order for lists of the same length. *)
+    type nonrec t = t
-let compare_bytes b1 b2 =
+
-  let len1 = MBytes.length b1 in
+    (* Fitness comparison:
-  let len2 = MBytes.length b2 in
+       - shortest lists are smaller ;
-  let c = compare len1 len2 in
+       - lexicographical order for lists of the same length. *)
-  if c <> 0
+    let compare_bytes b1 b2 =
-  then c
+      let len1 = MBytes.length b1 in
-  else
+      let len2 = MBytes.length b2 in
-    let rec compare_byte b1 b2 pos len =
+      let c = compare len1 len2 in
-      if pos = len
+      if c <> 0
-      then 0
+      then c
       else
-        let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
+        let rec compare_byte b1 b2 pos len =
-        if c <> 0
+          if pos = len
-        then c
+          then 0
-        else compare_byte b1 b2 (pos+1) len
+          else
-    in
+            let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in
-    compare_byte b1 b2 0 len1
+            if c <> 0
+            then c
+            else compare_byte b1 b2 (pos+1) len
+        in
+        compare_byte b1 b2 0 len1
 
-let compare f1 f2 =
+    let compare f1 f2 =
-  let rec compare_rec f1 f2 = match f1, f2 with
+      let rec compare_rec f1 f2 = match f1, f2 with
-    | [], [] -> 0
+        | [], [] -> 0
-    | i1 :: f1, i2 :: f2 ->
+        | i1 :: f1, i2 :: f2 ->
-        let i = compare_bytes i1 i2 in
+            let i = compare_bytes i1 i2 in
-        if i = 0 then compare_rec f1 f2 else i
+            if i = 0 then compare_rec f1 f2 else i
-    | _, _ -> assert false in
+        | _, _ -> assert false in
-  let len = compare (List.length f1) (List.length f2) in
+      let len = compare (List.length f1) (List.length f2) in
-  if len = 0 then compare_rec f1 f2 else len
+      if len = 0 then compare_rec f1 f2 else len
-
+  end)
-let equal f1 f2 = compare f1 f2 = 0
-
-let (=) = equal
-let (<>) x y = compare x y <> 0
-let (<) x y = compare x y < 0
-let (<=) x y = compare x y <= 0
-let (>=) x y = compare x y >= 0
-let (>) x y = compare x y > 0
-let min x y = if x <= y then x else y
-let max x y = if x <= y then y else x
 
 let rec pp fmt = function
   | [] -> ()

src/lib_base/operation.ml

@@ -22,6 +22,15 @@ type t = {
   shell: shell_header ;
   proto: MBytes.t ;
 }
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare o1 o2 =
+      let (>>) x y = if x = 0 then y () else x in
+      Block_hash.compare o1.shell.branch o1.shell.branch >> fun () ->
+      MBytes.compare o1.proto o2.proto
+  end)
+
 let encoding =
   let open Data_encoding in
   conv
@@ -35,21 +44,6 @@ let pp fmt op =
   Data_encoding.Json.pp fmt
     (Data_encoding.Json.construct encoding op)
 
-let compare o1 o2 =
-  let (>>) x y = if x = 0 then y () else x in
-  Block_hash.compare o1.shell.branch o1.shell.branch >> fun () ->
-  MBytes.compare o1.proto o2.proto
-let equal b1 b2 = compare b1 b2 = 0
-
-let (=) = equal
-let (<>) x y = compare x y <> 0
-let (<) x y = compare x y < 0
-let (<=) x y = compare x y <= 0
-let (>=) x y = compare x y >= 0
-let (>) x y = compare x y > 0
-let min x y = if x <= y then x else y
-let max x y = if x <= y then y else x
-
 let to_bytes v = Data_encoding.Binary.to_bytes encoding v
 let of_bytes b = Data_encoding.Binary.of_bytes encoding b
 let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b

src/lib_base/protocol.ml

@@ -20,6 +20,11 @@ and component = {
 
 and env_version = V1
 
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = Pervasives.compare
+  end)
+
 let component_encoding =
   let open Data_encoding in
   conv
@@ -74,18 +79,6 @@ let pp_ocaml ppf { expected_env ; components } =
        pp_ocaml_component)
     components
 
-let compare = Pervasives.compare
-let equal = (=)
-
-let (=) = equal
-let (<>) x y = compare x y <> 0
-let (<) x y = compare x y < 0
-let (<=) x y = compare x y <= 0
-let (>=) x y = compare x y >= 0
-let (>) x y = compare x y > 0
-let min x y = if x <= y then x else y
-let max x y = if x <= y then y else x
-
 let to_bytes v = Data_encoding.Binary.to_bytes encoding v
 let of_bytes b = Data_encoding.Binary.of_bytes encoding b
 let of_bytes_exn b = Data_encoding.Binary.of_bytes_exn encoding b

src/lib_base/s.ml

@@ -12,18 +12,7 @@ open Error_monad
 module type T = sig
 
   type t
-
+  include Compare.S with type t := t
-  val compare: t -> t -> int
-  val equal: t -> t -> bool
-
-  val (=): t -> t -> bool
-  val (<>): t -> t -> bool
-  val (<): t -> t -> bool
-  val (<=): t -> t -> bool
-  val (>=): t -> t -> bool
-  val (>): t -> t -> bool
-  val min: t -> t -> t
-  val max: t -> t -> t
 
   val pp: Format.formatter -> t -> unit
 

src/lib_base/time.ml

@@ -33,15 +33,6 @@ module T = struct
         if compare t1 t2 < 0 then a2 else a1
 
   let hash = to_int
-  let (=) = equal
-  let (<>) x y = compare x y <> 0
-  let (<) x y = compare x y < 0
-  let (<=) x y = compare x y <= 0
-  let (>=) x y = compare x y >= 0
-  let (>) x y = compare x y > 0
-  let min x y = if x <= y then x else y
-  let max x y = if x <= y then y else x
-
   let min_value = min_int
   let epoch = 0L
   let max_value = max_int
@@ -149,6 +140,7 @@ module T = struct
 end
 
 include T
-module Set = Set.Make(T)
+include Compare.Make (T)
-module Map = Map.Make(T)
+module Set = Set.Make (T)
-module Table = Hashtbl.Make(T)
+module Map = Map.Make (T)
+module Table = Hashtbl.Make (T)

src/lib_base/time.mli

@@ -8,6 +8,7 @@
 (**************************************************************************)
 
 type t
+include Compare.S with type t := t
 
 val min_value : t
 val epoch : t
@@ -16,18 +17,6 @@ val max_value : t
 val add : t -> int64 -> t
 val diff : t -> t -> int64
 
-val equal : t -> t -> bool
-val compare : t -> t -> int
-
-val (=) : t -> t -> bool
-val (<>) : t -> t -> bool
-val (<) : t -> t -> bool
-val (<=) : t -> t -> bool
-val (>=) : t -> t -> bool
-val (>) : t -> t -> bool
-val min : t -> t -> t
-val max : t -> t -> t
-
 val of_seconds : int64 -> t
 val to_seconds : t -> int64
 

src/lib_crypto/ed25519.ml

@@ -22,15 +22,12 @@ open Tweetnacl
 module Public_key = struct
 
   type t = Sign.public Sign.key
-  let compare a b = Cstruct.compare (Sign.to_cstruct a) (Sign.to_cstruct b)
+
-  let (=) xs ys = compare xs ys = 0
+  include Compare.Make(struct
-  let (<>) xs ys = compare xs ys <> 0
+      type nonrec t = t
-  let (<) xs ys = compare xs ys < 0
+      let compare a b =
-  let (<=) xs ys = compare xs ys <= 0
+        Cstruct.compare (Sign.to_cstruct a) (Sign.to_cstruct b)
-  let (>=) xs ys = compare xs ys >= 0
+    end)
-  let (>) xs ys = compare xs ys > 0
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
 
   type Base58.data +=
     | Public_key of t

src/lib_protocol_environment_sigs/v1/compare.mli

@@ -7,6 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
 module type S = sig
   type t
   val (=) : t -> t -> bool
@@ -16,10 +21,13 @@ module type S = sig
   val (>=) : t -> t -> bool
   val (>) : t -> t -> bool
   val compare : t -> t -> int
+  val equal : t -> t -> bool
   val max : t -> t -> t
   val min : t -> t -> t
 end
 
+module Make (P : COMPARABLE) : S with type t := P.t
+
 module Char : S with type t = char
 module Bool : S with type t = bool
 module Int : S with type t = int
@@ -29,5 +37,6 @@ module Int64 : S with type t = int64
 module Uint64 : S with type t = int64
 module Float : S with type t = float
 module String : S with type t = string
-module List(P : S) : S with type t = P.t list
+
-module Option(P : S) : S with type t = P.t option
+module List (P : COMPARABLE) : S with type t = P.t list
+module Option (P : COMPARABLE) : S with type t = P.t option

src/lib_protocol_environment_sigs/v1/s.mli

@@ -12,18 +12,7 @@
 module type T = sig
 
   type t
-
+  include Compare.S with type t := t
-  val compare: t -> t -> int
-  val equal: t -> t -> bool
-
-  val (=): t -> t -> bool
-  val (<>): t -> t -> bool
-  val (<): t -> t -> bool
-  val (<=): t -> t -> bool
-  val (>=): t -> t -> bool
-  val (>): t -> t -> bool
-  val min: t -> t -> t
-  val max: t -> t -> t
 
   val pp: Format.formatter -> t -> unit
 

src/lib_protocol_environment_sigs/v1/time.mli

@@ -8,22 +8,11 @@
 (**************************************************************************)
 
 type t
+include Compare.S with type t := t
 
 val add : t -> int64 -> t
 val diff : t -> t -> int64
 
-val equal : t -> t -> bool
-val compare : t -> t -> int
-
-val (=) : t -> t -> bool
-val (<>) : t -> t -> bool
-val (<) : t -> t -> bool
-val (<=) : t -> t -> bool
-val (>=) : t -> t -> bool
-val (>) : t -> t -> bool
-val min : t -> t -> t
-val max : t -> t -> t
-
 val of_seconds : int64 -> t
 val to_seconds : t -> int64
 

src/lib_stdlib/compare.ml

@@ -7,6 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
 module type S = sig
   type t
   val (=) : t -> t -> bool
@@ -16,76 +21,72 @@ module type S = sig
   val (>=) : t -> t -> bool
   val (>) : t -> t -> bool
   val compare : t -> t -> int
+  val equal : t -> t -> bool
   val max : t -> t -> t
   val min : t -> t -> t
 end
 
-module Char = struct
+module Make (P : COMPARABLE) = struct
-  type t = char
+  include P
-  let (=) = ((=) : t -> t -> bool)
-  let (<>) = ((<>) : t -> t -> bool)
-  let (<) = ((<) : t -> t -> bool)
-  let (<=) = ((<=) : t -> t -> bool)
-  let (>=) = ((>=) : t -> t -> bool)
-  let (>) = ((>) : t -> t -> bool)
   let compare = compare
+  let (=) a b = compare a b = 0
+  let (<>) a b = compare a b <> 0
+  let (<) a b = compare a b < 0
+  let (<=) a b = compare a b <= 0
+  let (>=) a b = compare a b >= 0
+  let (>) a b = compare a b > 0
+  let equal = (=)
   let max x y = if x >= y then x else y
   let min x y = if x <= y then x else y
 end
 
-module Bool = struct
+module List (P : COMPARABLE) = struct
-  type t = bool
+  type t = P.t list
-  let (=) = ((=) : t -> t -> bool)
+  let rec compare xs ys =
-  let (<>) = ((<>) : t -> t -> bool)
+    match xs, ys with
-  let (<) = ((<) : t -> t -> bool)
+    | [], [] -> 0
-  let (<=) = ((<=) : t -> t -> bool)
+    | [], _ -> -1
-  let (>=) = ((>=) : t -> t -> bool)
+    | _, [] -> 1
-  let (>) = ((>) : t -> t -> bool)
+    | x :: xs, y :: ys ->
-  let compare = compare
+        let hd = P.compare x y in
+        if hd <> 0 then hd else compare xs ys
+  let (=) xs ys = compare xs ys = 0
+  let (<>) xs ys = compare xs ys <> 0
+  let (<) xs ys = compare xs ys < 0
+  let (<=) xs ys = compare xs ys <= 0
+  let (>=) xs ys = compare xs ys >= 0
+  let (>) xs ys = compare xs ys > 0
+  let equal = (=)
   let max x y = if x >= y then x else y
   let min x y = if x <= y then x else y
 end
 
-module Int = struct
+module Option (P : COMPARABLE) = struct
-  type t = int
+  type t = P.t option
-  let (=) = ((=) : t -> t -> bool)
+  let compare xs ys =
-  let (<>) = ((<>) : t -> t -> bool)
+    match xs, ys with
-  let (<) = ((<) : t -> t -> bool)
+    | None, None -> 0
-  let (<=) = ((<=) : t -> t -> bool)
+    | None, _ -> -1
-  let (>=) = ((>=) : t -> t -> bool)
+    | _, None -> 1
-  let (>) = ((>) : t -> t -> bool)
+    | Some x, Some y -> P.compare x y
-  let compare = compare
+  let (=) xs ys = compare xs ys = 0
+  let (<>) xs ys = compare xs ys <> 0
+  let (<) xs ys = compare xs ys < 0
+  let (<=) xs ys = compare xs ys <= 0
+  let (>=) xs ys = compare xs ys >= 0
+  let (>) xs ys = compare xs ys > 0
+  let equal = (=)
   let max x y = if x >= y then x else y
   let min x y = if x <= y then x else y
 end
 
-module Int32 = struct
+module Char = Make (Char)
-  type t = int32
+module Bool = Make (struct type t = bool let compare = Pervasives.compare end)
-  let (=) = ((=) : t -> t -> bool)
+module Int = Make (struct type t = int let compare = Pervasives.compare end)
-  let (<>) = ((<>) : t -> t -> bool)
+module Int32 = Make (Int32)
-  let (<) = ((<) : t -> t -> bool)
+module Int64 = Make (Int64)
-  let (<=) = ((<=) : t -> t -> bool)
-  let (>=) = ((>=) : t -> t -> bool)
-  let (>) = ((>) : t -> t -> bool)
-  let compare = compare
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end
 
-module Int64 = struct
+module MakeUnsigned (Int : S) (Z : sig val zero : Int.t end) = struct
-  type t = int64
-  let (=) = ((=) : t -> t -> bool)
-  let (<>) = ((<>) : t -> t -> bool)
-  let (<) = ((<) : t -> t -> bool)
-  let (<=) = ((<=) : t -> t -> bool)
-  let (>=) = ((>=) : t -> t -> bool)
-  let (>) = ((>) : t -> t -> bool)
-  let compare = compare
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end
-
-module MakeUnsigned(Int : S)(Z : sig val zero : Int.t end) = struct
   type t = Int.t
   let compare va vb =
     Int.(if va >= Z.zero then if vb >= Z.zero then compare va vb else -1
@@ -104,73 +105,13 @@ module MakeUnsigned(Int : S)(Z : sig val zero : Int.t end) = struct
            (b < Z.zero && a <= b))
   let (>=) a b = (<=) b a
   let (>) a b = (<) b a
+  let equal = (=)
   let max x y = if x >= y then x else y
   let min x y = if x <= y then x else y
 end
 
-module Uint32 = MakeUnsigned(Int32)(struct let zero = 0l end)
+module Uint32 = MakeUnsigned (Int32) (struct let zero = 0l end)
-module Uint64 = MakeUnsigned(Int64)(struct let zero = 0L end)
+module Uint64 = MakeUnsigned (Int64) (struct let zero = 0L end)
 
-module Float = struct
+module Float = Make (struct type t = float let compare = Pervasives.compare end)
-  type t = float
+module String = Make (String)
-  let (=) = ((=) : t -> t -> bool)
-  let (<>) = ((<>) : t -> t -> bool)
-  let (<) = ((<) : t -> t -> bool)
-  let (<=) = ((<=) : t -> t -> bool)
-  let (>=) = ((>=) : t -> t -> bool)
-  let (>) = ((>) : t -> t -> bool)
-  let compare = compare
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end
-
-module String = struct
-  type t = string
-  let (=) = ((=) : t -> t -> bool)
-  let (<>) = ((<>) : t -> t -> bool)
-  let (<) = ((<) : t -> t -> bool)
-  let (<=) = ((<=) : t -> t -> bool)
-  let (>=) = ((>=) : t -> t -> bool)
-  let (>) = ((>) : t -> t -> bool)
-  let compare = compare
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end
-
-module List(P : S) = struct
-  type t = P.t list
-  let rec compare xs ys =
-    match xs, ys with
-    | [], [] -> 0
-    | [], _ -> -1
-    | _, [] -> 1
-    | x :: xs, y :: ys ->
-        let hd = P.compare x y in
-        if hd <> 0 then hd else compare xs ys
-  let (=) xs ys = compare xs ys = 0
-  let (<>) xs ys = compare xs ys <> 0
-  let (<) xs ys = compare xs ys < 0
-  let (<=) xs ys = compare xs ys <= 0
-  let (>=) xs ys = compare xs ys >= 0
-  let (>) xs ys = compare xs ys > 0
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end
-
-module Option(P : S) = struct
-  type t = P.t option
-  let compare xs ys =
-    match xs, ys with
-    | None, None -> 0
-    | None, _ -> -1
-    | _, None -> 1
-    | Some x, Some y -> P.compare x y
-  let (=) xs ys = compare xs ys = 0
-  let (<>) xs ys = compare xs ys <> 0
-  let (<) xs ys = compare xs ys < 0
-  let (<=) xs ys = compare xs ys <= 0
-  let (>=) xs ys = compare xs ys >= 0
-  let (>) xs ys = compare xs ys > 0
-  let max x y = if x >= y then x else y
-  let min x y = if x <= y then x else y
-end

src/lib_stdlib/compare.mli

@@ -7,6 +7,11 @@
 (*                                                                        *)
 (**************************************************************************)
 
+module type COMPARABLE = sig
+  type t
+  val compare : t -> t -> int
+end
+
 module type S = sig
   type t
   val (=) : t -> t -> bool
@@ -16,10 +21,13 @@ module type S = sig
   val (>=) : t -> t -> bool
   val (>) : t -> t -> bool
   val compare : t -> t -> int
+  val equal : t -> t -> bool
   val max : t -> t -> t
   val min : t -> t -> t
 end
 
+module Make (P : COMPARABLE) : S with type t := P.t
+
 module Char : S with type t = char
 module Bool : S with type t = bool
 module Int : S with type t = int
@@ -29,5 +37,6 @@ module Int64 : S with type t = int64
 module Uint64 : S with type t = int64
 module Float : S with type t = float
 module String : S with type t = string
-module List(P : S) : S with type t = P.t list
+
-module Option(P : S) : S with type t = P.t option
+module List (P : COMPARABLE) : S with type t = P.t list
+module Option (P : COMPARABLE) : S with type t = P.t option

src/lib_stdlib/mBytes.ml

@@ -81,20 +81,15 @@ let substring src srcoff len =
   Bytes.unsafe_to_string s
 
 include EndianBigstring.BigEndian
+include Compare.Make(struct
+    type nonrec t = t
+    let compare = Pervasives.compare
+  end)
 
 module LE = struct
   include EndianBigstring.LittleEndian
 end
 
-
-let (=) = ((=) : t -> t -> bool)
-let (<>) = ((<>) : t -> t -> bool)
-let (<) = ((<) : t -> t -> bool)
-let (<=) = ((<=) : t -> t -> bool)
-let (>=) = ((>=) : t -> t -> bool)
-let (>) = ((>) : t -> t -> bool)
-let compare = Pervasives.compare
-
 let concat b1 b2 =
   let l1 = length b1 in
   let l2 = length b2 in

src/lib_stdlib/mBytes.mli

@@ -16,6 +16,7 @@ open Bigarray
 
 (** Arrays are of characters, represented as uint8's, in row-major layout. *)
 type t = (char, int8_unsigned_elt, c_layout) Array1.t
+include Compare.S with type t := t
 
 val create: int -> t
 (** [create n] allocates and returns an array of size [n] **)
@@ -144,14 +145,6 @@ module LE: sig
 
 end
 
-val (=) : t -> t -> bool
-val (<>) : t -> t -> bool
-val (<) : t -> t -> bool
-val (<=) : t -> t -> bool
-val (>=) : t -> t -> bool
-val (>) : t -> t -> bool
-val compare : t -> t -> int
-
 val concat: t -> t -> t
 (** Returns a new array with adjacent copies of the two input arrays **)
 

src/proto_alpha/lib_protocol/src/constants_repr.ml

@@ -100,7 +100,7 @@ let map_option f = function
   | None -> None
   | Some x -> Some (f x)
 
-module CompareListInt = Compare.List(Compare.Int)
+module CompareListInt = Compare.List (Compare.Int)
 
 let constants_encoding =
   (* let open Data_encoding in *)

src/proto_alpha/lib_protocol/src/contract_repr.ml

@@ -10,6 +10,19 @@
 type t =
   | Default of Ed25519.Public_key_hash.t
   | Originated of Contract_hash.t
+
+include Compare.Make(struct
+    type nonrec t = t
+    let compare l1 l2 =
+      match l1, l2 with
+      | Default pkh1, Default pkh2 ->
+          Ed25519.Public_key_hash.compare pkh1 pkh2
+      | Originated h1, Originated h2 ->
+          Contract_hash.compare h1 h2
+      | Default _, Originated _ -> -1
+      | Originated _, Default _ -> 1
+  end)
+
 type contract = t
 
 type error += Invalid_contract_notation of string (* `Permanent *)
@@ -130,23 +143,6 @@ let arg =
     ~destruct
     ()
 
-let compare l1 l2 =
-  match l1, l2 with
-  | Default pkh1, Default pkh2 ->
-      Ed25519.Public_key_hash.compare pkh1 pkh2
-  | Originated h1, Originated h2 ->
-      Contract_hash.compare h1 h2
-  | Default _, Originated _ -> -1
-  | Originated _, Default _ -> 1
-let (=) l1 l2 = Compare.Int.(=) (compare l1 l2) 0
-let (<>) l1 l2 = Compare.Int.(<>) (compare l1 l2) 0
-let (>) l1 l2 = Compare.Int.(>) (compare l1 l2) 0
-let (>=) l1 l2 = Compare.Int.(>=) (compare l1 l2) 0
-let (<=) l1 l2 = Compare.Int.(<=) (compare l1 l2) 0
-let (<) l1 l2 = Compare.Int.(<) (compare l1 l2) 0
-let min l1 l2 = if l1 <= l2 then l1 else l2
-let max l1 l2 = if l1 >= l2 then l1 else l2
-
 module Index = struct
   type t = contract
   let path_length =

src/proto_alpha/lib_protocol/src/level_repr.ml

@@ -7,7 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-
 type t = {
   level: Raw_level_repr.t ;
   level_position: int32 ;
@@ -17,6 +16,11 @@ type t = {
   voting_period_position: int32 ;
 }
 
+include Compare.Make(struct
+    type nonrec t = t
+    let compare { level = l1 } { level = l2 } = Raw_level_repr.compare l1 l2
+  end)
+
 type level = t
 
 let pp ppf { level } = Raw_level_repr.pp ppf level
@@ -80,13 +84,3 @@ let from_raw ~first_level ~cycle_length ~voting_period_length level =
 let diff { level = l1 } { level = l2 } =
   Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
 
-let compare { level = l1 } { level = l2 } = Raw_level_repr.compare l1 l2
-let (=) { level = l1 } { level = l2 } = Raw_level_repr.(=) l1 l2
-let (<>) { level = l1 } { level = l2 } = Raw_level_repr.(<>) l1 l2
-let (>) { level = l1 } { level = l2 } = Raw_level_repr.(>) l1 l2
-let (>=) { level = l1 } { level = l2 } = Raw_level_repr.(>=) l1 l2
-let (<=) { level = l1 } { level = l2 } = Raw_level_repr.(<=) l1 l2
-let (<) { level = l1 } { level = l2 } = Raw_level_repr.(<) l1 l2
-let min l1 l2 = if l1 <= l2 then l1 else l2
-let max l1 l2 = if l1 >= l2 then l1 else l2
-

src/proto_alpha/lib_protocol/src/level_repr.mli

@@ -17,10 +17,12 @@ type t = private {
 }
 
 type level = t
+
+include Compare.S with type t := level
+
 val encoding: level Data_encoding.t
 val pp: Format.formatter -> level -> unit
 val pp_full: Format.formatter -> level -> unit
-include Compare.S with type t := level
 
 val root: Raw_level_repr.t -> level