aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-07-29 14:25:10 +0000
committerGravatar puech <puech@85f007b7-540e-0410-9357-904b9bb8a0f7>2011-07-29 14:25:10 +0000
commit4eba5c485defc6f14e7e6e11e4b157011a2017fb (patch)
treebd2ab4311c0b3d8e05156c2df43efac9ed7a5a2b
parenta7331c608a2fb52f11ec3fc4abbae78d68f4682a (diff)
Evarutil: generic equality on constr replaced by eq_constr (x2)
added array_equal in Util git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@14323 85f007b7-540e-0410-9357-904b9bb8a0f7
-rw-r--r--lib/util.ml6
-rw-r--r--lib/util.mli1
-rw-r--r--pretyping/evarutil.ml6
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 =