Ltac ecareful_unify :=
  match goal with
  | |- ?X = ?X' => first [is_Type_or_type X | is_evar X | is_evar X' | constr_eq X X']; reflexivity
  | |- ?F _ = ?F' _ => first [apply fun_equal | apply fun_equal' with (f := F)]; revgoals; solve[ecareful_unify]
  end; idtac.Ltac careful_unify :=
  match goal with
  | |- ?X = ?X' => first [is_Type_or_type X | constr_eq X X']; reflexivity
  | |- ?F _ = ?F' _ => first [apply fun_equal | apply fun_equal' with (f := F)]; revgoals; solve[careful_unify]
  end; idtac.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
           ]
         ].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."
  ].(* 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).(* 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).(* 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).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.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.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.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.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.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.Inductive construct_fold_right_sepcon_rec: mpred -> list mpred -> list mpred -> Prop :=
| construct_fold_right_sepcon_rec_sepcon: forall P Q R R' R'',
    construct_fold_right_sepcon_rec Q R R' ->
    construct_fold_right_sepcon_rec P R' R'' ->
    construct_fold_right_sepcon_rec (P * Q) R R''
| construct_fold_right_sepcon_rec_emp: forall R,
    construct_fold_right_sepcon_rec emp R R
| construct_fold_right_sepcon_rec_single: forall P R,
    construct_fold_right_sepcon_rec P R (P :: R).Inductive construct_fold_right_sepcon_rec: mpred -> list mpred -> list mpred -> Prop :=
| construct_fold_right_sepcon_rec_sepcon: forall P Q R R' R'',
    construct_fold_right_sepcon_rec Q R R' ->
    construct_fold_right_sepcon_rec P R' R'' ->
    construct_fold_right_sepcon_rec (P * Q) R R''
| construct_fold_right_sepcon_rec_emp: forall R,
    construct_fold_right_sepcon_rec emp R R
| construct_fold_right_sepcon_rec_single: forall P R,
    construct_fold_right_sepcon_rec P R (P :: R).Inductive construct_fold_right_sepcon_rec: mpred -> list mpred -> list mpred -> Prop :=
| construct_fold_right_sepcon_rec_sepcon: forall P Q R R' R'',
    construct_fold_right_sepcon_rec Q R R' ->
    construct_fold_right_sepcon_rec P R' R'' ->
    construct_fold_right_sepcon_rec (P * Q) R R''
| construct_fold_right_sepcon_rec_emp: forall R,
    construct_fold_right_sepcon_rec emp R R
| construct_fold_right_sepcon_rec_single: forall P R,
    construct_fold_right_sepcon_rec P R (P :: R).Ltac construct_fold_right_sepcon :=
  apply construct_fold_right_sepcon_constr;
  construct_fold_right_sepcon_rec.(* ensure that we avoid name collision with the above *)
Inductive construct_fold_right_sepcon: mpred -> list mpred-> Prop :=
| construct_fold_right_sepcon_constr: forall P R,
    construct_fold_right_sepcon_rec P nil R ->
    construct_fold_right_sepcon P R.

(* Specifications: *)
Lemma construct_fold_right_sepcon_spec: forall P R, construct_fold_right_sepcon P R -> fold_right_sepcon R = P.