diff options
| author | herbelin | 2009-08-06 11:34:12 +0000 |
|---|---|---|
| committer | herbelin | 2009-08-06 11:34:12 +0000 |
| commit | da7fb3e13166747b49cdf1ecfad394ecb4e0404a (patch) | |
| tree | 51e8aacf24c5dc6fd395bf162590d80568e2882d /tactics/equality.ml | |
| parent | 81785201c87ba994507ade890cedc99503d69112 (diff) | |
Move out JMeq of subst for compatibility (it affects e.g. the
compilation of Grenoble/ATBR). Add subst' for subst extended with JMeq
(maybe an option would be better??).
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12264 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'tactics/equality.ml')
| -rw-r--r-- | tactics/equality.ml | 10 |
1 files changed, 7 insertions, 3 deletions
diff --git a/tactics/equality.ml b/tactics/equality.ml index 01e5efc70c..699f334412 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -1208,6 +1208,9 @@ let unfold_body x gl = +let restrict_to_eq_and_identity eq = (* compatibility *) + if eq <> constr_of_global glob_eq && eq <> constr_of_global glob_identity then + raise PatternMatchingFailure exception FoundHyp of (identifier * constr * bool) @@ -1220,7 +1223,7 @@ let is_eq_x gl x (id,_,c) = with PatternMatchingFailure -> () -let subst_one x gl = +let subst_one x gl = let hyps = pf_hyps gl in let (_,xval,_) = pf_get_hyp gl x in (* If x has a body, simply replace x with body and clear x *) @@ -1275,10 +1278,11 @@ let subst_one x gl = let subst ids = tclTHEN tclNORMEVAR (tclMAP subst_one ids) -let subst_all gl = +let subst_all ?(strict=true) gl = let test (_,c) = try - let (_,x,y) = snd (find_eq_data_decompose gl c) in + let lbeq,(_,x,y) = find_eq_data_decompose gl c in + if strict then restrict_to_eq_and_identity lbeq.eq; (* J.F.: added to prevent failure on goal containing x=x as an hyp *) if eq_constr x y then failwith "caught"; match kind_of_term x with Var x -> x | _ -> |