From 0dfd0fb7d7c04eedfb3b161b9b5cfab103c17916 Mon Sep 17 00:00:00 2001
From: Hugo Herbelin <Hugo.Herbelin@inria.fr>
Date: Sun, 13 Mar 2016 17:48:28 +0100
Subject: Adding a few functions on type union.

---
 lib/util.ml  | 33 ++++++++++++++++++++++++++++++---
 lib/util.mli |  8 ++++++++
 2 files changed, 38 insertions(+), 3 deletions(-)

diff --git a/lib/util.ml b/lib/util.ml
index 0f79c10df..cae996e33 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -132,9 +132,36 @@ type ('a, 'b) union = ('a, 'b) CSig.union = Inl of 'a | Inr of 'b
 type 'a until = 'a CSig.until = Stop of 'a | Cont of 'a
 type ('a, 'b) eq = ('a, 'b) CSig.eq = Refl : ('a, 'a) eq
 
-let map_union f g = function
-  | Inl a -> Inl (f a)
-  | Inr b -> Inr (g b)
+module Union =
+struct
+  let map f g = function
+    | Inl a -> Inl (f a)
+    | Inr b -> Inr (g b)
+
+  (** Lifting equality onto union types. *)
+  let equal f g x y = match x, y with
+    | Inl x, Inl y -> f x y
+    | Inr x, Inr y -> g x y
+    | _, _ -> false
+
+  let fold_left f g a = function
+    | Inl y -> f a y
+    | Inr y -> g a y
+    | _ -> a
+end
+
+let map_union = Union.map
+
+(** Lifting equality onto union types. *)
+let equal_union f g x y = match x, y with
+  | Inl x, Inl y -> f x y
+  | Inr x, Inr y -> g x y
+  | _, _ -> false
+
+let fold_left_union f g a = function
+  | Inl y -> f a y
+  | Inr y -> g a y
+  | _ -> a
 
 type iexn = Exninfo.iexn
 
diff --git a/lib/util.mli b/lib/util.mli
index 559874bb8..6bed7e355 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -114,7 +114,15 @@ val iraise : iexn -> 'a
 type ('a, 'b) union = ('a, 'b) CSig.union = Inl of 'a | Inr of 'b
 (** Union type *)
 
+module Union :
+sig
+  val map : ('a -> 'c) -> ('b -> 'd) -> ('a, 'b) union -> ('c, 'd) union
+  val equal : ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) union -> ('a, 'b) union -> bool
+  val fold_left : ('c -> 'a -> 'c) -> ('c -> 'b -> 'c) -> 'c -> ('a, 'b) union -> 'c
+end
+
 val map_union : ('a -> 'c) -> ('b -> 'd) -> ('a, 'b) union -> ('c, 'd) union
+(** Alias for [Union.map] *)
 
 type 'a until = 'a CSig.until = Stop of 'a | Cont of 'a
 (** Used for browsable-until structures. *)
-- 
cgit v1.2.3