From 08bc15dd8c74d3c170e3fabec23ffaba4b658d80 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Sun, 9 Apr 2017 15:11:12 +0200
Subject: [PATCH] add module `CCEqual`

---
 _oasis               |  2 +-
 doc/intro.txt        |  1 +
 src/core/CCEqual.ml  | 49 ++++++++++++++++++++++++++++++++++++++++++++
 src/core/CCEqual.mli | 39 +++++++++++++++++++++++++++++++++++
 4 files changed, 90 insertions(+), 1 deletion(-)
 create mode 100644 src/core/CCEqual.ml
 create mode 100644 src/core/CCEqual.mli

diff --git a/_oasis b/_oasis
index b3f54836..19753b57 100644
--- a/_oasis
+++ b/_oasis
@@ -42,7 +42,7 @@ Library "containers"
                     CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray, CCRef, CCSet,
                     CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
                     CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
-                    CCListLabels, CCArrayLabels,
+                    CCListLabels, CCArrayLabels, CCEqual,
                     Containers
   BuildDepends:     bytes, result
   # BuildDepends:     bytes, bisect_ppx
diff --git a/doc/intro.txt b/doc/intro.txt
index 461a5ece..72eb19d2 100644
--- a/doc/intro.txt
+++ b/doc/intro.txt
@@ -30,6 +30,7 @@ CCArrayLabels
 CCArray_slice
 CCBool
 CCChar
+CCEqual
 CCFloat
 CCFormat
 CCFun
diff --git a/src/core/CCEqual.ml b/src/core/CCEqual.ml
new file mode 100644
index 00000000..9bcafb7e
--- /dev/null
+++ b/src/core/CCEqual.ml
@@ -0,0 +1,49 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Equality Combinators} *)
+
+type 'a t = 'a -> 'a -> bool
+
+let poly = (=)
+
+let int = (=)
+let string = (=)
+let bool = (=)
+let float = (=)
+
+let rec list f l1 l2 = match l1, l2 with
+  | [], [] -> true
+  | [], _ | _, [] -> false
+  | x1::l1', x2::l2' -> f x1 x2 && list f l1' l2'
+
+let array eq a b =
+  let rec aux i =
+    if i = Array.length a then true
+    else eq a.(i) b.(i) && aux (i+1)
+  in
+  Array.length a = Array.length b
+  &&
+  aux 0
+
+let option f o1 o2 = match o1, o2 with
+  | None, None -> true
+  | Some _, None
+  | None, Some _ -> false
+  | Some x, Some y -> f x y
+
+let pair f g (x1,y1)(x2,y2) = f x1 x2 && g y1 y2
+let triple f g h (x1,y1,z1)(x2,y2,z2) = f x1 x2 && g y1 y2 && h z1 z2
+
+let map f eq x y = eq (f x) (f y)
+
+(*$Q
+  Q.(let p = small_list (pair small_int bool) in pair p p) (fun (l1,l2) -> \
+    CCEqual.(list (pair int bool)) l1 l2 = (l1=l2))
+*)
+
+module Infix = struct
+  let (>|=) x f = map f x
+end
+
+include Infix
diff --git a/src/core/CCEqual.mli b/src/core/CCEqual.mli
new file mode 100644
index 00000000..6eb5fa9d
--- /dev/null
+++ b/src/core/CCEqual.mli
@@ -0,0 +1,39 @@
+
+(* This file is free software, part of containers. See file "license" for more details. *)
+
+(** {1 Equality Combinators} *)
+
+(** @since NEXT_RELEASE *)
+
+type 'a t = 'a -> 'a -> bool
+(** Equality function. Must be transitive, symmetric, and reflexive. *)
+
+val poly : 'a t
+(** Standard polymorphic equality *)
+
+val int : int t
+val string : string t
+val bool : bool t
+val float : float t
+
+val list : 'a t -> 'a list t
+val array : 'a t -> 'a array t
+
+val option : 'a t -> 'a option t
+val pair : 'a t -> 'b t -> ('a * 'b) t
+val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
+
+val map : ('a -> 'b) -> 'b t -> 'a t
+(** [map f eq] is the equality function that, given objects [x] and [y],
+    projects [x] and [y] using [f] (e.g. using a record field) and then
+    compares those projections with [eq].
+    Example:
+    [map fst int] compares values of type [(int * 'a)]  by their
+      first component. *)
+
+val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+(** Infix equivalent of {!map} *)
+
+module Infix : sig
+  val (>|=) : 'b t -> ('a -> 'b) -> 'a t
+end