diff --git a/src/lib_base/block_header.ml b/src/lib_base/block_header.ml index 4ad144579..ee783e624 100644 --- a/src/lib_base/block_header.ml +++ b/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 diff --git a/src/lib_base/fitness.ml b/src/lib_base/fitness.ml index e3059e12b..40cee4d71 100644 --- a/src/lib_base/fitness.ml +++ b/src/lib_base/fitness.ml @@ -9,47 +9,41 @@ type t = MBytes.t list -(* Fitness comparison: - - shortest lists are smaller ; - - lexicographical order for lists of the same length. *) -let compare_bytes b1 b2 = - let len1 = MBytes.length b1 in - let len2 = MBytes.length b2 in - let c = compare len1 len2 in - if c <> 0 - then c - else - let rec compare_byte b1 b2 pos len = - if pos = len - then 0 +include Compare.Make(struct + + type nonrec t = t + + (* Fitness comparison: + - shortest lists are smaller ; + - lexicographical order for lists of the same length. *) + let compare_bytes b1 b2 = + let len1 = MBytes.length b1 in + let len2 = MBytes.length b2 in + let c = compare len1 len2 in + if c <> 0 + then c else - let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in - if c <> 0 - then c - else compare_byte b1 b2 (pos+1) len - in - compare_byte b1 b2 0 len1 + let rec compare_byte b1 b2 pos len = + if pos = len + then 0 + else + let c = compare (MBytes.get_char b1 pos) (MBytes.get_char b2 pos) in + 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 rec compare_rec f1 f2 = match f1, f2 with - | [], [] -> 0 - | i1 :: f1, i2 :: f2 -> - let i = compare_bytes i1 i2 in - if i = 0 then compare_rec f1 f2 else i - | _, _ -> assert false in - let len = compare (List.length f1) (List.length f2) in - if len = 0 then compare_rec f1 f2 else len - -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 compare f1 f2 = + let rec compare_rec f1 f2 = match f1, f2 with + | [], [] -> 0 + | i1 :: f1, i2 :: f2 -> + let i = compare_bytes i1 i2 in + if i = 0 then compare_rec f1 f2 else i + | _, _ -> assert false in + let len = compare (List.length f1) (List.length f2) in + if len = 0 then compare_rec f1 f2 else len + end) let rec pp fmt = function | [] -> () diff --git a/src/lib_base/operation.ml b/src/lib_base/operation.ml index 08437b33a..bd7ebc34f 100644 --- a/src/lib_base/operation.ml +++ b/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 diff --git a/src/lib_base/protocol.ml b/src/lib_base/protocol.ml index 884c6ca58..f174a059b 100644 --- a/src/lib_base/protocol.ml +++ 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 diff --git a/src/lib_base/s.ml b/src/lib_base/s.ml index e76664349..871129449 100644 --- a/src/lib_base/s.ml +++ b/src/lib_base/s.ml @@ -12,18 +12,7 @@ open Error_monad module type T = sig type 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 + include Compare.S with type t := t val pp: Format.formatter -> t -> unit diff --git a/src/lib_base/time.ml b/src/lib_base/time.ml index 5353f8dad..9bcb86701 100644 --- a/src/lib_base/time.ml +++ b/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) -module Map = Map.Make(T) -module Table = Hashtbl.Make(T) +include Compare.Make (T) +module Set = Set.Make (T) +module Map = Map.Make (T) +module Table = Hashtbl.Make (T) diff --git a/src/lib_base/time.mli b/src/lib_base/time.mli index 241007f8e..eb7ac7631 100644 --- a/src/lib_base/time.mli +++ b/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 diff --git a/src/lib_crypto/ed25519.ml b/src/lib_crypto/ed25519.ml index 2b64acfd4..e522189c2 100644 --- a/src/lib_crypto/ed25519.ml +++ b/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 - 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 + + include Compare.Make(struct + type nonrec t = t + let compare a b = + Cstruct.compare (Sign.to_cstruct a) (Sign.to_cstruct b) + end) type Base58.data += | Public_key of t diff --git a/src/lib_protocol_environment_sigs/v1/compare.mli b/src/lib_protocol_environment_sigs/v1/compare.mli index 5de2c271f..133d351f6 100644 --- a/src/lib_protocol_environment_sigs/v1/compare.mli +++ b/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 diff --git a/src/lib_protocol_environment_sigs/v1/s.mli b/src/lib_protocol_environment_sigs/v1/s.mli index 1f8eae26b..bf3137da3 100644 --- a/src/lib_protocol_environment_sigs/v1/s.mli +++ b/src/lib_protocol_environment_sigs/v1/s.mli @@ -12,18 +12,7 @@ module type T = sig type 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 + include Compare.S with type t := t val pp: Format.formatter -> t -> unit diff --git a/src/lib_protocol_environment_sigs/v1/time.mli b/src/lib_protocol_environment_sigs/v1/time.mli index 2cced2387..9d4fd5473 100644 --- a/src/lib_protocol_environment_sigs/v1/time.mli +++ b/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 diff --git a/src/lib_stdlib/compare.ml b/src/lib_stdlib/compare.ml index e2c2cd4fa..e5fe3597d 100644 --- a/src/lib_stdlib/compare.ml +++ b/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 - type t = char - let (=) = ((=) : t -> t -> bool) - let (<>) = ((<>) : t -> t -> bool) - let (<) = ((<) : t -> t -> bool) - let (<=) = ((<=) : t -> t -> bool) - let (>=) = ((>=) : t -> t -> bool) - let (>) = ((>) : t -> t -> bool) +module Make (P : COMPARABLE) = struct + include P 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 - type t = bool - 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 +module List (P : COMPARABLE) = 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 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 - type t = int - 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 +module Option (P : COMPARABLE) = 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 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 - type t = int32 - 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 Char = Make (Char) +module Bool = Make (struct type t = bool let compare = Pervasives.compare end) +module Int = Make (struct type t = int let compare = Pervasives.compare end) +module Int32 = Make (Int32) +module Int64 = Make (Int64) -module Int64 = 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 +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 Uint64 = MakeUnsigned(Int64)(struct let zero = 0L end) +module Uint32 = MakeUnsigned (Int32) (struct let zero = 0l end) +module Uint64 = MakeUnsigned (Int64) (struct let zero = 0L end) -module Float = struct - type t = float - 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 +module Float = Make (struct type t = float let compare = Pervasives.compare end) +module String = Make (String) diff --git a/src/lib_stdlib/compare.mli b/src/lib_stdlib/compare.mli index 5de2c271f..133d351f6 100644 --- a/src/lib_stdlib/compare.mli +++ b/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 diff --git a/src/lib_stdlib/mBytes.ml b/src/lib_stdlib/mBytes.ml index a954ef223..22df84a77 100644 --- a/src/lib_stdlib/mBytes.ml +++ b/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 diff --git a/src/lib_stdlib/mBytes.mli b/src/lib_stdlib/mBytes.mli index 6e24ddae7..883197d97 100644 --- a/src/lib_stdlib/mBytes.mli +++ b/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 **) diff --git a/src/proto_alpha/lib_protocol/src/constants_repr.ml b/src/proto_alpha/lib_protocol/src/constants_repr.ml index 3de84f314..0b74cc348 100644 --- a/src/proto_alpha/lib_protocol/src/constants_repr.ml +++ b/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 *) diff --git a/src/proto_alpha/lib_protocol/src/contract_repr.ml b/src/proto_alpha/lib_protocol/src/contract_repr.ml index 388d473c1..277f54449 100644 --- a/src/proto_alpha/lib_protocol/src/contract_repr.ml +++ b/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 = diff --git a/src/proto_alpha/lib_protocol/src/level_repr.ml b/src/proto_alpha/lib_protocol/src/level_repr.ml index 99571f319..cac26deb9 100644 --- a/src/proto_alpha/lib_protocol/src/level_repr.ml +++ b/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 - diff --git a/src/proto_alpha/lib_protocol/src/level_repr.mli b/src/proto_alpha/lib_protocol/src/level_repr.mli index 488adb5e9..203200a2c 100644 --- a/src/proto_alpha/lib_protocol/src/level_repr.mli +++ b/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