Ltac local_cancel_in_syntactic_cancel unify_tac :=
cbv beta;
match goal with |- ?A |-- ?B =>
solve [ constr_eq A B; simple apply (derives_refl A)
| tryif first [has_evar A | has_evar B] then fail else auto with nocore cancel
| apply derives_refl'; unify_tac ]
end.
Ltac syntactic_cancel local_tac :=
repeat first
[ simple apply syntactic_cancel_nil
| simple apply syntactic_cancel_cons;
[ find_nth local_tac
| cbv iota; unfold delete_nth; cbv zeta iota
]
].
(* To solve: Frame := ?Frame |- fold_right_sepcon G |-- fold_right_sepcon L * fold_right_sepcon Frame *)
Ltac cancel_for_evar_frame' local_tac :=
eapply syntactic_cancel_spec1;
[ syntactic_cancel local_tac
| cbv iota; cbv zeta beta;
first [ match goal with
| |- _ |-- _ * fold_right_sepcon ?F => try unfold F
end;
simple apply syntactic_cancel_solve1
| match goal with
| |- fold_right_sepcon ?A |-- fold_right_sepcon ?B * _ => rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B)
end;
unfold fold_left_sepconx; cbv iota beta ]
].
(* To solve: |- fold_right_sepcon G |-- fold_right_sepcon L * TT *)
Ltac cancel_for_TT local_tac :=
eapply syntactic_cancel_spec1;
[ syntactic_cancel local_tac
| cbv iota; cbv zeta beta;
first [ simple apply syntactic_cancel_solve2
| match goal with
| |- fold_right_sepcon ?A |-- fold_right_sepcon ?B * _ => rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B)
end;
unfold fold_left_sepconx; cbv iota beta ]
].
Ltac cancel_for_normal local_tac :=
eapply syntactic_cancel_spec3;
[ syntactic_cancel local_tac
| cbv iota; cbv zeta beta;
first [ simple apply syntactic_cancel_solve3
| match goal with
| |- fold_right_sepcon ?A |-- fold_right_sepcon ?B => rewrite <- (fold_left_sepconx_eq A), <- (fold_left_sepconx_eq B)
end;
unfold fold_left_sepconx; cbv iota beta ]
].
(* return Some true exists TT, return Some false if exists fold_right_sepcon. *)
(* unused? Ltac Check_normal_mpred_list_rec L := match L with | nil => constr:(@None bool) | cons TT _ => constr:(Some true) | cons (fold_right_sepcon _) _ => constr:(Some false) | cons _ ?L0 => Check_normal_mpred_list_rec L0 end.  Ltac Check_pre_no_TT L := let res := Check_normal_mpred_list_rec L in match res with | Some true => fail 1000 "No TT should appear in the SEP clause of a funcspec's precondition" | _ => idtac end. *)
Inductive merge_abnormal_mpred: mpred -> option mpred -> option mpred -> Prop :=
| merge_abnormal_mpred_None: forall P, merge_abnormal_mpred P None (Some P)
| merge_abnormal_mpred_TT_Some: forall P, merge_abnormal_mpred TT (Some P) (Some P)
| merge_abnormal_mpred_Some_TT: forall P, merge_abnormal_mpred P (Some TT) (Some P).
Inductive fold_abnormal_mpred: list mpred -> list mpred -> option mpred -> Prop :=
| fold_abnormal_mpred_nil:
fold_abnormal_mpred nil nil None
| fold_abnormal_mpred_TT: forall R res R' res',
fold_abnormal_mpred R R' res ->
merge_abnormal_mpred TT res res' ->
fold_abnormal_mpred (TT :: R) R' res'
| fold_abnormal_mpred_fold: forall F R res R' res',
fold_abnormal_mpred R R' res ->
merge_abnormal_mpred (fold_right_sepcon F) res res' ->
fold_abnormal_mpred ((fold_right_sepcon F) :: R) R' res'
| fold_abnormal_mpred_normal: forall P R R' res,
fold_abnormal_mpred R R' res ->
fold_abnormal_mpred (P :: R) (P :: R') res.
Definition Some_or_emp (res: option mpred) := match res with | Some P => P | _ => emp end.

(* Specifications: *)
Lemma merge_abnormal_mpred_spec: forall P res res',
merge_abnormal_mpred P res res' ->
Some_or_emp res' |-- P * Some_or_emp res.
Lemma fold_abnormal_mpred_spec: forall R R' res,
fold_abnormal_mpred R R' res ->
fold_right_sepcon R' * Some_or_emp res |-- fold_right_sepcon R.