pl/frap
1
0
Fork 0
mirror of https://github.com/achlipala/frap.git synced 2024-11-10 00:07:51 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make SepCancel more conservative

Browse source
This commit is contained in:
Adam Chlipala 2016-05-01 18:53:25 -04:00
parent 8c67fc5468
commit 035bfa57ee
1 changed files with 16 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
SepCancel.v
View file

@ -329,9 +329,10 @@ Module Make(Import S : SEP).
Ltac cancel1 := Ltac cancel1 :=
match goal with match goal with
| [ |- ?p ===> ?q ] => | [ |- ?p ===> ?q ] =>
forAllAtoms p ltac:(fun p0 => (is_var q; fail 2)
|| forAllAtoms p ltac:(fun p0 =>
(let H := fresh in assert (H : try_me_first p0) by eauto; clear H); (let H := fresh in assert (H : try_me_first p0) by eauto; clear H);
sendToBack p0; sendToBack p0;
forAllAtoms q ltac:(fun q0 => forAllAtoms q ltac:(fun q0 =>
(let H := fresh in assert (H : try_me_first q0) by eauto; clear H); (let H := fresh in assert (H : try_me_first q0) by eauto; clear H);
sendToBack q0; sendToBack q0;
@ -345,7 +346,8 @@ Module Make(Import S : SEP).
| _ => apply himp_refl | _ => apply himp_refl
end end
| [ |- ?p ===> ?q ] => | [ |- ?p ===> ?q ] =>
forAllAtoms p ltac:(fun p0 => (is_var q; fail 2)
|| forAllAtoms p ltac:(fun p0 =>
sendToBack p0; sendToBack p0;
forAllAtoms q ltac:(fun q0 => forAllAtoms q ltac:(fun q0 =>
sendToBack q0; sendToBack q0;
@ -359,7 +361,7 @@ Module Make(Import S : SEP).
| [ |- _ ===> ?Q ] => is_evar Q; set Q | [ |- _ ===> ?Q ] => is_evar Q; set Q
| [ |- context[star ?P _] ] => is_evar P; set P | [ |- context[star ?P _] ] => is_evar P; set P
| [ |- context[star _ ?Q] ] => is_evar Q; set Q | [ |- context[star _ ?Q] ] => is_evar Q; set Q
| [ |- _ ===> (exists v, _ * ?R v) ] => is_evar R; set R | [ |- _ ===> exists v, _ * ?R v ] => is_evar R; set R
end. end.
Ltac restore_evars := Ltac restore_evars :=
@ -425,11 +427,15 @@ Module Make(Import S : SEP).
quantifyOverThem vars P k). quantifyOverThem vars P k).
Ltac basic_cancel := Ltac basic_cancel :=
normalize; repeat cancel1; intuition eassumption. normalize; repeat cancel1; repeat match goal with
| [ H : _ /\ _ |- _ ] => destruct H
| [ |- _ /\ _ ] => split
end; eassumption.
Ltac cancel := hide_evars; normalize; repeat cancel1; restore_evars; Ltac cancel := hide_evars; normalize; repeat cancel1; restore_evars;
repeat match goal with repeat match goal with
| [ H : True |- _ ] => clear H | [ H : True |- _ ] => clear H
| [ H : ?P, H' : ?P |- _ ] => clear H'
end; end;
try match goal with try match goal with
| [ |- _ ===> ?p * ?q ] => | [ |- _ ===> ?p * ?q ] =>
@ -472,5 +478,9 @@ Module Make(Import S : SEP).
basic_cancel basic_cancel
end) end)
| [ |- _ ===> _ ] => intuition (try congruence) | [ |- _ ===> _ ] => intuition (try congruence)
end; intuition idtac. end; intuition idtac;
repeat match goal with
| [ H : True |- _ ] => clear H
| [ H : ?P, H' : ?P |- _ ] => clear H'
end.
End Make. End Make.