(* Require Import VST.msl.alg_seplog. *)
Local Open Scope logic.
Hint Extern 0 (_ |-- _) => match goal with |- ?A |-- ?B => constr_eq A B; simple apply derives_refl end : core.
(* Hint Resolve @derives_refl.    too expensive sometimes when it fails . . . *)
Ltac solve_andp' :=
first [ apply derives_refl
| apply andp_left1; solve_andp'
| apply andp_left2; solve_andp'].
Ltac solve_andp := repeat apply andp_right; solve_andp'.
Hint Resolve @TT_right: norm.
Hint Resolve @FF_left : norm.
Ltac norm := auto with norm.
Proof with norm.
intros.
apply pred_ext.
apply andp_right. apply andp_left2... apply andp_left1...
apply andp_right. apply andp_left2... apply andp_left1...
Qed.
Class CCCviaNatDed (A: Type) (prod expo: A -> A -> A) {ND: NatDed A}: Prop :=
isCCC: CartesianClosedCat.CCC A derives eq prod expo.
Instance andp_imp_CCC: forall A {ND : NatDed A}, CCCviaNatDed A andp imp.
Instance sepcon_wand_CCC: forall A {ND : NatDed A} {SL: SepLog A}, CCCviaNatDed A sepcon wand.
Hint Rewrite @FF_sepcon @sepcon_FF : norm.
Hint Rewrite @FF_andp @andp_FF : norm.
Proof with norm.
intros.
apply pred_ext.
apply andp_left1...
apply andp_right...
Qed.
Proof with norm.
intros.
rewrite sepcon_comm. rewrite sepcon_andp_prop.
rewrite sepcon_comm; auto.
Qed.
Proof with norm.
intros; rewrite sepcon_comm. apply sepcon_emp.
Qed.
Proof with norm.
intros. apply pred_ext. apply andp_left2... apply andp_right...
Qed.
Proof with norm.
intros.
apply pred_ext. apply andp_left2...
apply andp_right... apply prop_right...
Qed.
Ltac immediate := (assumption || reflexivity).
Hint Rewrite @prop_true_andp using (solve [immediate]) : norm.
Proof with norm.
intros. apply pred_ext...
apply prop_right...
Qed.
Hint Rewrite @true_eq using (solve [immediate]) : norm.
Hint Rewrite @andp_dup : norm.
Proof with norm.
intros.
apply @derives_trans with (P * emp).
rewrite sepcon_emp...
apply sepcon_derives...
Qed.
Hint Resolve @sepcon_TT : core.
Hint Rewrite @sepcon_emp @emp_sepcon @TT_andp @andp_TT
@exp_sepcon1 @exp_sepcon2
@exp_andp1 @exp_andp2
@sepcon_andp_prop @sepcon_andp_prop'
using (solve [auto with typeclass_instances])
: norm.
Ltac pull_left A := repeat (rewrite <- (pull_right A) || rewrite <- (pull_right0 A)).
Ltac pull_right A := repeat (rewrite (pull_right A) || rewrite (pull_right0 A)).

Lemma derives_extract_prop0 {A}{NA: NatDed A}:
forall (P: Prop) (R: A), (P -> TT |-- R)  -> !!P |-- R.