Ltac construct_fold_right_sepcon_rec :=
match goal with
| |- construct_fold_right_sepcon_rec (sepcon _ _) _ _ =>
eapply construct_fold_right_sepcon_rec_sepcon;
[construct_fold_right_sepcon_rec | construct_fold_right_sepcon_rec]
| |- construct_fold_right_sepcon_rec emp _ _ =>
apply construct_fold_right_sepcon_rec_emp
| _ =>
apply construct_fold_right_sepcon_rec_single
end.
Ltac merge_abnormal_mpred :=
first
[ simple apply merge_abnormal_mpred_None
| simple apply merge_abnormal_mpred_TT_Some
| simple apply merge_abnormal_mpred_Some_TT
| fail 1000 "There should not be two fold_right_sepcon in the right side."
].
Ltac construct_fold_right_sepcon :=
apply construct_fold_right_sepcon_constr;
construct_fold_right_sepcon_rec.
Ltac is_evar_def F := try first [is_var F; unfold F; fail 1 | fail 2 F "is not evar definition"].
Ltac fold_abnormal_mpred :=
match goal with
| |- fold_abnormal_mpred nil _ _ =>
simple apply fold_abnormal_mpred_nil
| |- fold_abnormal_mpred (?P :: _) _ _ =>
match P with
| TT => simple eapply fold_abnormal_mpred_TT; [fold_abnormal_mpred | merge_abnormal_mpred]
| prop True => simple eapply fold_abnormal_mpred_TT; [fold_abnormal_mpred | merge_abnormal_mpred]
| fold_right_sepcon ?F =>
is_evar_def F;
simple eapply fold_abnormal_mpred_fold; [fold_abnormal_mpred | merge_abnormal_mpred]
| _ => simple apply fold_abnormal_mpred_normal; fold_abnormal_mpred
end
end.
Ltac new_cancel local_tac :=
match goal with
| |- @derives mpred Nveric _ _ => idtac
| _ => fail 1000 "Tactic cancel can only handle proof goals with form _ |-- _ (unlifted version)."
end;
eapply symbolic_cancel_setup;
[ construct_fold_right_sepcon
| construct_fold_right_sepcon
| fold_abnormal_mpred
| match goal with
| |- before_symbol_cancel _ _ None =>
cbv iota beta delta [before_symbol_cancel];
cancel_for_normal local_tac
| |- before_symbol_cancel _ _ (Some (fold_right_sepcon _)) =>
cbv iota beta delta [before_symbol_cancel];
cancel_for_evar_frame' local_tac
| |- before_symbol_cancel _ _ (Some TT) =>
cbv iota beta delta [before_symbol_cancel];
cancel_for_TT local_tac
| |- before_symbol_cancel _ _ (Some (prop True)) =>
cbv iota beta delta [before_symbol_cancel];
cancel_for_TT local_tac
end
].
Ltac cancel_unify_tac :=
autorewrite with cancel;
careful_unify.
Ltac cancel_local_tac :=
cbv beta;
match goal with |- ?A |-- ?B =>
solve [ constr_eq A B; simple apply (derives_refl A)
| auto with nocore cancel
| apply derives_refl'; cancel_unify_tac]
end.
Ltac cancel ::= new_cancel cancel_local_tac.
Ltac no_evar_cancel_local_tac := local_cancel_in_syntactic_cancel cancel_unify_tac.
Ltac no_evar_cancel := new_cancel no_evar_cancel_local_tac.
Ltac ecancel_unify_tac :=
autorewrite with cancel;
ecareful_unify.
Ltac ecancel_local_tac := local_cancel_in_syntactic_cancel ecancel_unify_tac.
Ltac pure_ecancel := new_cancel ecancel_local_tac.
Ltac ecancel := no_evar_cancel; pure_ecancel.
Ltac old_local_tac := local_cancel_in_syntactic_cancel careful_unify.
Ltac cancel_for_evar_frame := cancel_for_evar_frame' ecancel_local_tac.
Ltac info_cancel_local_tac :=
(tryif try (cancel_local_tac; gfail 1)
then match goal with |- ?Goal => idtac Goal "fail" end
else match goal with |- ?Goal => idtac Goal "success" end);
cancel_local_tac.
Ltac info_cancel := new_cancel info_cancel_local_tac.
Ltac info_ecancel_local_tac :=
(tryif try (ecancel_local_tac; gfail 1)
then match goal with |- ?Goal => idtac Goal "fail" end
else match goal with |- ?Goal => idtac Goal "success" end);
ecancel_local_tac.
Ltac info_ecancel := info_cancel; new_cancel info_ecancel_local_tac.

(* Specifications: *)
(*  Export ListNotations.  Goal forall A B C D E F G H I J K L: mpred, A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) * A * B * (C * D) * (E * F * (G * H)) * (I * J * K * L) |-- (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G) * (I * J * (D * K) * L) * A * B * (C * H) * (E * F * G).  Lemma cancel_emp_wand: forall P Q R: mpred, P |-- Q -> P |-- Q * (R -* R).  Ltac cancel_wand := repeat match goal with |- _ |-- ?B => match B with context [?A -* ?A] => rewrite ?sepcon_assoc; pull_right (A -* A); first [apply cancel_emp_wand | apply wand_refl_cancel_right] end end.  Ltac norm_rewrite := autorewrite with norm. (* New version: rewrite_strat (topdown hints norm). But this will have to wait for a future version of Coq in which rewrite_strat discharges side conditions. According to Matthieu Sozeau, in the Coq trunk as of June 5, 2013, rewrite_strat is documented AND discharges side conditions. It might be about twice as fast, or 1.7 times as fast, as the old autorewrite. And then, maybe use "bottomup" instead of "topdown", see if that's better.  To test whether your version of Coq works, use this: *)
Lemma TEST_L : forall n:nat, n=n -> (n + 1 = S n)%nat.
Hint Rewrite TEST_L using reflexivity : test888.