You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
87 lines
3.3 KiB
87 lines
3.3 KiB
3 years ago
|
(*
|
||
|
|
* Copyright (c) Facebook, Inc. and its affiliates.
|
||
|
|
*
|
||
|
|
* This source code is licensed under the MIT license found in the
|
||
|
|
* LICENSE file in the root directory of this source tree.
|
||
|
|
*)
|
||
|
|
|
||
|
|
(** Singleton types for compare functions *)
|
||
|
|
|
||
|
|
(** A comparer [('a, 'compare_a) t] for type ['a] is a "compare" function of
|
||
|
|
type ['a -> 'a -> int] tagged with a phantom type ['compare_a] acting as
|
||
|
|
a singleton type denoting an individual compare function. *)
|
||
|
|
type ('a, 'compare_a) t = private 'a -> 'a -> int
|
||
|
|
|
||
|
|
module type S = sig
|
||
|
|
type ('a, 'compare_a) comparer := ('a, 'compare_a) t
|
||
|
|
type t
|
||
|
|
|
||
|
|
(** [compare] types are equipped with functions to support use of
|
||
|
|
[@@deriving compare, equal, sexp] on types parameterized by such
|
||
|
|
singleton types for compare functions. These derived functions are
|
||
|
|
never actually called, since the compare type parameters are phantom. *)
|
||
|
|
type compare [@@deriving compare, equal, sexp]
|
||
|
|
|
||
|
|
val comparer : (t, compare) comparer
|
||
|
|
end
|
||
|
|
|
||
|
|
(** [Make] takes a [compare] function, mints a fresh [compare] type to act
|
||
|
|
as a singleton type denoting that one compare function, and returns the
|
||
|
|
[compare] function at a type stamped with its singleton type. In this
|
||
|
|
way, [Make] applied to two different compare functions for the same type
|
||
|
|
of values yields comparers with incompatible types. *)
|
||
|
|
module Make (Ord : sig
|
||
|
|
type t [@@deriving compare]
|
||
|
|
end) : S with type t = Ord.t
|
||
|
|
|
||
|
|
(** [Counterfeit] takes a compare function and type and yields a comparer
|
||
|
|
that asserts that the given [compare] type is a singleton for the given
|
||
|
|
[compare] function. This is not checked by the type system. It is the
|
||
|
|
client's responsibility to ensure that distinct types are provided for
|
||
|
|
distinct compare functions. If the same type is used for multiple
|
||
|
|
functions, then [Counterfeit] will produce type-compatible comparers
|
||
|
|
even though the wrapped compare functions differ. *)
|
||
|
|
module Counterfeit (Ord : sig
|
||
|
|
type t [@@deriving compare]
|
||
|
|
type compare [@@deriving compare, equal, sexp]
|
||
|
|
end) : S with type t = Ord.t with type compare = Ord.compare
|
||
|
|
|
||
|
|
(** [Apply (F) (A)] takes a type [('a, 'compare_a) F.t] with a type
|
||
|
|
parameter ['a] and a compare type ['compare_a] for ['a], and a comparer
|
||
|
|
[A], and creates a comparer for [F.t] with ['a] instantiated to [A.t]. *)
|
||
|
|
module Apply (F : sig
|
||
|
|
type ('a, 'compare_a) t [@@deriving compare]
|
||
|
|
type 'compare_a compare [@@deriving compare, equal, sexp]
|
||
|
|
end)
|
||
|
|
(A : S) : sig
|
||
|
|
type t = (A.t, A.compare) F.t [@@deriving compare]
|
||
|
|
|
||
|
|
include S with type t := t with type compare = A.compare F.compare
|
||
|
|
end
|
||
|
|
|
||
|
|
module type S1 = sig
|
||
|
|
type ('a, 'compare_a) comparer := ('a, 'compare_a) t
|
||
|
|
type 'a t
|
||
|
|
type 'compare_a compare [@@deriving compare, equal, sexp]
|
||
|
|
|
||
|
|
val comparer :
|
||
|
|
('a, 'compare_a) comparer -> ('a t, 'compare_a compare) comparer
|
||
|
|
end
|
||
|
|
|
||
|
|
(** [Apply1 (F) (A)] takes a type [('a, 'b, 'compare_a) F.t] with two type
|
||
|
|
parameters ['a], ['b] and a compare type ['compare_a] for ['a], and a
|
||
|
|
comparer [A], and creates a comparer for [F.t] with ['a] instantiated to
|
||
|
|
[A.t]. *)
|
||
|
|
module Apply1 (F : sig
|
||
|
|
type ('a, 'b, 'compare_a) t [@@deriving compare]
|
||
|
|
type ('compare_a, 'compare_b) compare [@@deriving compare, equal, sexp]
|
||
|
|
end)
|
||
|
|
(A : S) : sig
|
||
|
|
type 'b t = (A.t, 'b, A.compare) F.t [@@deriving compare]
|
||
|
|
|
||
|
|
include
|
||
|
|
S1
|
||
|
|
with type 'b t := 'b t
|
||
|
|
with type 'compare_b compare = (A.compare, 'compare_b) F.compare
|
||
|
|
end
|