diff options
author | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2016-03-13 17:48:28 +0100 |
---|---|---|
committer | Hugo Herbelin <Hugo.Herbelin@inria.fr> | 2016-03-13 17:48:28 +0100 |
commit | 0dfd0fb7d7c04eedfb3b161b9b5cfab103c17916 (patch) | |
tree | 9517b8e5e12cc25e20dc436e5086bfd216739a7b | |
parent | 04b7394eaae170685a09ccd85ef47991466e6681 (diff) |
Adding a few functions on type union.
-rw-r--r-- | lib/util.ml | 33 | ||||
-rw-r--r-- | 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. *) |