diff options
| author | msozeau | 2008-07-25 13:16:32 +0000 |
|---|---|---|
| committer | msozeau | 2008-07-25 13:16:32 +0000 |
| commit | 26d532da9063cdac9c693ebed29551662158bbb3 (patch) | |
| tree | 519ce11d54168e091dc5f48f5b130d4132f87402 | |
| parent | be9c3dc93413a76d188724d4a06739d9bb238b72 (diff) | |
A better test for relations being setoids or not: do leibniz rewrite iff
the applied relation is an abbreviation for @eq. Fixes bug #1915.
git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@11264 85f007b7-540e-0410-9357-904b9bb8a0f7
| -rw-r--r-- | tactics/equality.ml | 13 | ||||
| -rw-r--r-- | test-suite/bugs/closed/shouldfail/1915.v | 6 |
2 files changed, 16 insertions, 3 deletions
diff --git a/tactics/equality.ml b/tactics/equality.ml index 8831a9e572..8d849e643d 100644 --- a/tactics/equality.ml +++ b/tactics/equality.ml @@ -88,12 +88,20 @@ let general_s_rewrite_clause = function let general_setoid_rewrite_clause = ref general_s_rewrite_clause let register_general_setoid_rewrite_clause = (:=) general_setoid_rewrite_clause +let dest_applied_relation t = + match kind_of_term t with + | App (c, args) when Array.length args >= 2 -> + mkApp (c, Array.append (Array.sub args 0 (Array.length args - 2)) [|mkProp;mkProp|]) + | _ -> t + let general_rewrite_ebindings_clause cls lft2rgt occs (c,l) with_evars gl = let ctype = pf_apply get_type_of gl c in let env = pf_env gl in let sigma = project gl in - let _,t = splay_prod env sigma ctype in - match match_with_equation t with + let t = snd (decompose_prod (whd_betaiotazeta ctype)) in + let head = dest_applied_relation t in + let _,t' = splay_prod env sigma head in + match match_with_equation t' with | None -> if l = NoBindings then !general_setoid_rewrite_clause cls lft2rgt occs c ~new_goals:[] gl @@ -114,7 +122,6 @@ let general_rewrite_ebindings_clause cls lft2rgt occs (c,l) with_evars gl = try general_elim_clause with_evars cls (c,l) (elim,NoBindings) gl with e -> let eq = build_coq_eq () in - let t = snd (decompose_prod (whd_betaiotazeta ctype)) in let head = if isApp t then fst (destApp t) else t in if not (eq_constr eq head) then try !general_setoid_rewrite_clause cls lft2rgt occs c ~new_goals:[] gl diff --git a/test-suite/bugs/closed/shouldfail/1915.v b/test-suite/bugs/closed/shouldfail/1915.v new file mode 100644 index 0000000000..a96a482c68 --- /dev/null +++ b/test-suite/bugs/closed/shouldfail/1915.v @@ -0,0 +1,6 @@ + +Require Import Setoid. + +Goal forall x, impl True (x = 0) -> x = 0 -> False. +intros x H E. +rewrite H in E.
\ No newline at end of file |