Ltac unfold_right_sepcon A :=
lazymatch A with
| (?B * ?C)%logic => let x := unfold_right_sepcon C
in let y := constr:(B :: x)
in y
| ?D => let y := constr:(D::nil) in y
end.
Ltac cancel_frame :=
match goal with
| |- _ |-- fold_right_sepcon _  => (* setup *)
rewrite !sepcon_assoc; cancel_frame
| F := ?v |- ?A |-- fold_right_sepcon ?F  => (* fast way *)
is_evar v;
apply fold_right_sepconx_eqx;
let w := unfold_right_sepcon A
in instantiate (1:=w) in (Value of F);
unfold F;
unfold fold_right_sepconx;
simple apply derives_refl
(* | |- _ |-- fold_right_sepcon ?F  =>  (* slow way *)
repeat apply cancel_frame2_low;
try (unfold F; apply cancel_frame0_low);
try (unfold F; apply cancel_frame1_low)
*)
| |- ?P |-- fold_right _ _ ?F ?rho  =>
let P' := abstract_env rho P in
change ( P' rho |-- fold_right sepcon emp F rho);
fixup_lifts; cbv beta;
repeat rewrite sepcon_assoc;
repeat match goal with |- (_ * _) _ |-- _ =>
apply cancel_frame2
end;
try (unfold F; apply cancel_frame1);
try (instantiate (1:=nil) in (Value of F); unfold F; apply cancel_frame0)
end.
Ltac pull_left A :=
(* For some reason in Coq 8.4pl3 and perhaps other versions, this works better than the version in log_normalize which is simply, repeat rewrite <- (pull_right A) || rewrite <- (pull_right0 A) and which sometimes fails when the terms get complicated. *)
repeat match goal with
| |- context [?Q * ?R * A] => rewrite <- (pull_right A Q R)
| |- context [?Q * A] => rewrite <- (pull_right0 A Q)
end.

(* Specifications: *)
Lemma cancel_left: forall P Q R: mpred,
Q |-- R -> P * Q |-- P * R.
Lemma pull_left_special: forall A B C : mpred,
(B * (A * C)) = (A * (B * C)).
Lemma pull_left_special0: forall A B : mpred,
(B * A) = (A * B).