Local Open Scope logic.
Hint Rewrite <- prop_and : gather_prop.
Hint Rewrite gather_prop_left gather_prop_right : gather_prop.
Definition not_a_prop {A} (P: A) := True.
Ltac not_a_prop := match goal with
| |- not_a_prop  (prop _) => fail 1
| |- _ => apply Coq.Init.Logic.I
end.
Hint Rewrite @gather_prop3 using not_a_prop : gather_prop.
Hint Rewrite @gather_prop4 using not_a_prop : gather_prop.
Hint Rewrite @gather_prop5 using not_a_prop : gather_prop.
Hint Rewrite @sepcon_andp_prop @sepcon_andp_prop' : gather_prop.
(*Hint Rewrite <- sepcon_assoc : gather_prop.*)
(* These versions can sometimes take minutes, when A and B can't be unified Hint Extern 1 (_ |-- _) => (simple apply (@derives_refl mpred _) ) : cancel. Hint Extern 1 (_ |-- |> _) => (simple apply (@now_later mpred _ _) ) : cancel. *)
Hint Extern 2 (?A |-- ?B) => (constr_eq A B; simple apply derives_refl) : cancel.
Hint Extern 2 (?A |-- |> ?B) => (constr_eq A B; simple apply now_later) : cancel.
Ltac cancel1 :=
first [
simple apply cancel1_here; [
try match goal with H := _ : list mpred |- _ => clear H end; (*
this line is to work around Coq 8.4 bug,
Anomaly: undefined_evars_of_term *)
solve [eauto with nocore cancel]
| ]
| simple apply cancel1_next; cancel1
| simple apply cancel1_last; [
try match goal with H := _ : list mpred |- _ => clear H end; (*
this line is to work around Coq 8.4 bug,
Anomaly: undefined_evars_of_term *)
solve [eauto with nocore cancel] | ]
].
Ltac cancel2 :=
simple apply cancel1_start;
cancel1;
repeat simple apply cancel1_finish1;
try simple apply cancel1_finish2.
Ltac lift1 a e1 rho  :=
match e1 with
| lift0 rho => constr:(a)
| lift0 ?a1 => constr: (lift0 (a a1))
| _ => constr:(lift1 a e1)
end.
Ltac lift2 a e1 e2 rho :=
match e1 with
|  lift0 ?a1 => lift1 (a a1) e2 rho
| _ => constr:(lift2 a e1 e2)
end.
Ltac lift3 a e1 e2 e3 rho :=
match e1 with
|  lift0 ?a1 => lift2 (a a1) e2 e3 rho
| _ => constr:(lift3 a e1 e2 e3)
end.
Ltac lift4 a e1 e2 e3 e4 rho :=
match e1 with
|  lift0 ?a1 => lift3 (a a1) e2 e3 e4 rho
| _ => constr:(lift4 a e1 e2 e3 e4)
end.
Ltac abstract_env rho P :=
match P with
| @emp mpred _ _ => constr:(@emp (environ->mpred) _ _)
| @sepcon mpred _ _ ?e1 ?e2 =>
let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2
in constr:(@sepcon (environ->mpred) _ _ e1' e2')
| ?a0 ?a1 ?a2 ?e1 ?e2 ?e3 ?e4 =>
let e1' := abstract_env rho e1  in let e2' := abstract_env rho e2 in let e3' := abstract_env rho e3 in let e4' := abstract_env rho e4
in lift3 (a0 a1 a2) e1' e2' e3' e4' rho
| ?a0 ?a1 ?e1 ?e2 ?e3 ?e4 =>
let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2 in let e3' := abstract_env rho e3 in let e4' := abstract_env rho e4
in lift3 (a0 a1) e1' e2' e3' e4' rho
| ?a0 ?e1 ?e2 ?e3 ?e4 =>
let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2 in let e3' := abstract_env rho e3 in let e4' := abstract_env rho e4
in lift4 a0 e1' e2' e3' e4' rho
| ?a0 ?e1 ?e2 ?e3 =>
let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2 in let e3' := abstract_env rho e3
in lift3 a0 e1' e2' e3' rho
| ?a0 ?e1 ?e2 =>
let e1' := abstract_env rho e1 in let e2' := abstract_env rho e2
in lift2 a0 e1' e2' rho
| ?a0 ?e1 => let e1' := abstract_env rho e1 in lift1 a0 e1' rho
| rho => constr: (lift1)
| ?a => constr:(lift0 a)
end.

Lemma cancel_frame2_low: forall (P Q: mpred) F,
Q  |-- fold_right_sepcon F  ->
(P * Q) |-- fold_right_sepcon (P::F).