diff options
| -rw-r--r-- | lib/option.ml | 17 | ||||
| -rw-r--r-- | lib/option.mli | 12 | ||||
| -rw-r--r-- | lib/util.ml | 5 | ||||
| -rw-r--r-- | lib/util.mli | 1 | ||||
| -rw-r--r-- | proofs/logic.ml | 2 |
5 files changed, 30 insertions, 7 deletions
diff --git a/lib/option.ml b/lib/option.ml index 436358b555..5539058136 100644 --- a/lib/option.ml +++ b/lib/option.ml @@ -147,3 +147,20 @@ module List = | x::l -> cons x (flatten l) | [] -> [] end + + + +(** {6 Miscelaneous Primitives} *) + +module Misc = + struct + (** [Misc.compare f x y] lifts the equality predicate [f] to + option types. That is, if both [x] and [y] are [None] then + it returns [true], if they are bothe [Some _] then + [f] is called. Otherwise it returns [false]. *) + let compare f x y = + match x,y with + | None, None -> true + | Some z, Some w -> f z w + | _,_ -> false +end diff --git a/lib/option.mli b/lib/option.mli index 8e768d8af2..4047ebe1a2 100644 --- a/lib/option.mli +++ b/lib/option.mli @@ -98,3 +98,15 @@ module List : sig [Some y] (in the same order). *) val flatten : 'a option list -> 'a list end + + +(** {6 Miscelaneous Primitives} *) + +module Misc : sig + (** [Misc.compare f x y] lifts the equality predicate [f] to + option types. That is, if both [x] and [y] are [None] then + it returns [true], if they are bothe [Some _] then + [f] is called. Otherwise it returns [false]. *) + val compare : ('a -> 'a -> bool) -> 'a option -> 'a option -> bool +end + diff --git a/lib/util.ml b/lib/util.ml index 99a203d52f..586365dd83 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -788,11 +788,6 @@ let interval n m = in interval_n ([],m) -let option_compare f a b = match (a,b) with - | None, None -> true - | Some a', Some b' -> f a' b' - | _ -> failwith "option_compare" - let map_succeed f = let rec map_f = function diff --git a/lib/util.mli b/lib/util.mli index 331363f0ae..88b246a72b 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -223,7 +223,6 @@ val intmap_inv : 'a Intmap.t -> 'a -> int list val interval : int -> int -> int list -val option_compare : ('a -> 'b -> bool) -> 'a option -> 'b option -> bool (* In [map_succeed f l] an element [a] is removed if [f a] raises *) (* [Failure _] otherwise behaves as [List.map f l] *) diff --git a/proofs/logic.ml b/proofs/logic.ml index 136f613436..9573f54382 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -378,7 +378,7 @@ let convert_hyp sign sigma (id,b,bt as d) = let env = Global.env_of_context sign in if !check && not (is_conv env sigma bt ct) then error ("Incorrect change of the type of "^(string_of_id id)); - if !check && not (option_compare (is_conv env sigma) b c) then + if !check && not (Option.Misc.compare (is_conv env sigma) b c) then error ("Incorrect change of the body of "^(string_of_id id)); d) |