diff options
| -rw-r--r-- | lib/util.ml | 6 | ||||
| -rw-r--r-- | lib/util.mli | 1 | ||||
| -rw-r--r-- | pretyping/evarutil.ml | 6 |
3 files changed, 10 insertions, 3 deletions
diff --git a/lib/util.ml b/lib/util.ml index 67ff2a501..6a69c58d2 100644 --- a/lib/util.ml +++ b/lib/util.ml @@ -887,6 +887,12 @@ let array_compare item_cmp v1 v2 = else cmp (i-1) in cmp (Array.length v1 - 1) +let array_equal cmp t1 t2 = + Array.length t1 = Array.length t2 && + let rec aux i = + (i = Array.length t1) || (cmp t1.(i) t2.(i) && aux (i + 1)) + in aux 0 + let array_exists f v = let rec exrec = function | -1 -> false diff --git a/lib/util.mli b/lib/util.mli index 458eb1d05..8606d830f 100644 --- a/lib/util.mli +++ b/lib/util.mli @@ -237,6 +237,7 @@ val list_union_map : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b (** {6 Arrays. } *) val array_compare : ('a -> 'a -> int) -> 'a array -> 'a array -> int +val array_equal : ('a -> 'a -> bool) -> 'a array -> 'a array -> bool val array_exists : ('a -> bool) -> 'a array -> bool val array_for_all : ('a -> bool) -> 'a array -> bool val array_for_all2 : ('a -> 'b -> bool) -> 'a array -> 'b array -> bool diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml index 77ea20e15..0cf1594b5 100644 --- a/pretyping/evarutil.ml +++ b/pretyping/evarutil.ml @@ -677,8 +677,8 @@ let rec assoc_up_to_alias sigma aliases y yc = function else (* Last chance, we reason up to alias conversion *) match (if c == c' then cc else expand_full_opt aliases c') with - | Some cc when yc = cc -> id - | _ -> if yc = c then id else raise Not_found + | Some cc when eq_constr yc cc -> id + | _ -> if eq_constr yc c then id else raise Not_found let rec find_projectable_vars with_evars aliases sigma y subst = let yc = expand_var aliases y in @@ -983,7 +983,7 @@ let solve_evar_evar f env evd ev1 ev2 = * depend on these args). *) let solve_refl conv_algo env evd evk argsv1 argsv2 = - if argsv1 = argsv2 then evd else + if array_equal eq_constr argsv1 argsv2 then evd else let evi = Evd.find_undefined evd evk in (* Filter and restrict if needed *) let evd,evk,args = |