balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Comparable: add Make

Browse Source
This commit is contained in:
Vincent Bernardoff 2018-02-13 17:30:25 +01:00 committed by Grégoire Henry
parent 040d99b673
commit f8ded9ca28
19 changed files with 187 additions and 330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
src/lib_base/block_header.ml
View File

@ -48,20 +48,9 @@ type t = {
proto: MBytes.t ;
}
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
let pp ppf op =
Data_encoding.Json.pp ppf
(Data_encoding.Json.construct encoding op)
let compare b1 b2 =
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
@ -76,17 +65,20 @@ let compare b1 b2 =
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 equal b1 b2 = compare b1 b2 = 0
let encoding =
let open Data_encoding in
conv
(fun { shell ; proto } -> (shell, proto))
(fun (shell, proto) -> { shell ; proto })
(merge_objs
shell_header_encoding
(obj1 (req "data" Variable.bytes)))
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 pp ppf op =
Data_encoding.Json.pp ppf
(Data_encoding.Json.construct encoding op)
let to_bytes v = Data_encoding.Binary.to_bytes encoding v
let of_bytes b = Data_encoding.Binary.of_bytes encoding b

22
src/lib_base/fitness.ml
View File

@ -9,10 +9,14 @@
type t = MBytes.t list
(* Fitness comparison:
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 compare_bytes b1 b2 =
let len1 = MBytes.length b1 in
let len2 = MBytes.length b2 in
let c = compare len1 len2 in
@ -30,7 +34,7 @@ let compare_bytes b1 b2 =
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
| [], [] -> 0
| i1 :: f1, i2 :: f2 ->
@ -39,17 +43,7 @@ let compare f1 f2 =
| _, _ -> 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
end)
let rec pp fmt = function
| [] -> ()

24
src/lib_base/operation.ml
View File

@ -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

17
src/lib_base/protocol.ml
View File

@ -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

13
src/lib_base/s.ml
View File

@ -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

16
src/lib_base/time.ml
View File

@ -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)

13
src/lib_base/time.mli
View File

@ -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

15
src/lib_crypto/ed25519.ml
View File

@ -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

13
src/lib_protocol_environment_sigs/v1/compare.mli
View File

@ -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

13
src/lib_protocol_environment_sigs/v1/s.mli
View File

@ -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

13
src/lib_protocol_environment_sigs/v1/time.mli
View File

@ -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

175
src/lib_stdlib/compare.ml
View File

@ -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)

13
src/lib_stdlib/compare.mli
View File

@ -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

13
src/lib_stdlib/mBytes.ml
View File

@ -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

9
src/lib_stdlib/mBytes.mli
View File

@ -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 **)

2
src/proto_alpha/lib_protocol/src/constants_repr.ml
View File

@ -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 *)

30
src/proto_alpha/lib_protocol/src/contract_repr.ml
View File

@ -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 =

16
src/proto_alpha/lib_protocol/src/level_repr.ml
View File

@ -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

4
src/proto_alpha/lib_protocol/src/level_repr.mli
View File

@ -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