Source file comparator.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
open! Import

type ('a, 'witness) t =
  { compare   : 'a -> 'a -> int
  ; sexp_of_t : 'a -> Sexp.t
  }

type ('a, 'b) comparator = ('a, 'b) t

module type S = sig
  type t
  type comparator_witness
  val comparator : (t, comparator_witness) comparator
end

module type S1 = sig
  type 'a t
  type comparator_witness
  val comparator : ('a t, comparator_witness) comparator
end

module type S_fc = sig
  type comparable_t
  include S with type t := comparable_t
end

let make (type t) ~compare ~sexp_of_t =
  (module struct
    type comparable_t = t
    type comparator_witness
    let comparator = { compare; sexp_of_t }
  end : S_fc with type comparable_t = t)

module S_to_S1 (S : S) = struct
  type 'a t = S.t
  type comparator_witness = S.comparator_witness
  open S
  let comparator = comparator
end

module Make (M : sig type t [@@deriving_inline compare, sexp_of]
    include
    sig
      [@@@ocaml.warning "-32"]
      val compare : t -> t -> int
      val sexp_of_t : t -> Ppx_sexp_conv_lib.Sexp.t
    end[@@ocaml.doc "@inline"]
    [@@@end] end) = struct
  include M
  type comparator_witness
  let comparator = M.({ compare; sexp_of_t })
end

module Make1 (M : sig
    type 'a t
    val compare : 'a t -> 'a t -> int
    val sexp_of_t : 'a t -> Sexp.t
  end) = struct
  type comparator_witness
  let comparator = M.({ compare; sexp_of_t })
end

module Poly = struct
  type 'a t = 'a
  include Make1 (struct
      type 'a t = 'a
      let compare = Poly.compare
      let sexp_of_t _ = Sexp.Atom "_"
    end)
end

module type Derived = sig
  type 'a t
  type 'cmp comparator_witness

  val comparator
    :  ('a, 'cmp) comparator
    -> ('a t, 'cmp comparator_witness) comparator
end

module Derived (M : sig type 'a t [@@deriving_inline compare, sexp_of]
    include
    sig
      [@@@ocaml.warning "-32"]
      val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
      val sexp_of_t :
        ('a -> Ppx_sexp_conv_lib.Sexp.t) -> 'a t -> Ppx_sexp_conv_lib.Sexp.t
    end[@@ocaml.doc "@inline"]
    [@@@end] end) = struct
  type 'cmp comparator_witness

  let comparator a = {
    compare = M.compare a.compare;
    sexp_of_t = M.sexp_of_t a.sexp_of_t;
  }
end

module type Derived2 = sig
  type ('a, 'b) t
  type ('cmp_a, 'cmp_b) comparator_witness

  val comparator
    :  ('a, 'cmp_a) comparator
    -> ('b, 'cmp_b) comparator
    -> (('a, 'b) t, ('cmp_a, 'cmp_b) comparator_witness) comparator
end

module Derived2 (M : sig type ('a, 'b) t [@@deriving_inline compare, sexp_of]
    include
    sig
      [@@@ocaml.warning "-32"]
      val compare :
        ('a -> 'a -> int) ->
        ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int
      val sexp_of_t :
        ('a -> Ppx_sexp_conv_lib.Sexp.t) ->
        ('b -> Ppx_sexp_conv_lib.Sexp.t) ->
        ('a, 'b) t -> Ppx_sexp_conv_lib.Sexp.t
    end[@@ocaml.doc "@inline"]
    [@@@end] end) = struct
  type ('cmp_a, 'cmp_b) comparator_witness

  let comparator a b = {
    compare = M.compare a.compare b.compare;
    sexp_of_t = M.sexp_of_t a.sexp_of_t b.sexp_of_t;
  }
end