Local Open Scope pred.
Hint Rewrite @sepcon_emp @emp_sepcon @TT_and @andp_TT
@exp_sepcon1 @exp_sepcon2
@exp_andp1 @exp_andp2
@sepcon_andp_prop @sepcon_andp_prop'
: normalize.
Definition pure {A}{JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{agA: ageable A}{AgeA: Age_alg A}
(P: pred A) : Prop :=
P |-- emp.
Hint Resolve @pure_e : core.
Hint Resolve @pure_emp : core.
Hint Resolve @pure_existential : core.
Hint Rewrite @FF_sepcon @sepcon_FF : normalize.
Hint Rewrite @prop_true_andp using (solve [auto]) : normalize.
Hint Rewrite @true_eq using (solve [auto]) : normalize.
Hint Resolve @pure_con' : core.
Hint Resolve @pure_intersection1 @pure_intersection2 : core.
Hint Rewrite @FF_andp @andp_FF : normalize.
Hint Rewrite @andp_dup : normalize.
Hint Resolve @sepcon_TT : core.
Hint Rewrite @pure_sepcon_TT_andp @pure_sepcon_TT_andp' using (solve [auto]): normalize.
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)).
Ltac normalize1 :=
match goal with
| |- _ => contradiction
| |- context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) by (auto with normalize)
| |- context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) by (auto with normalize)
| |- context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) by (auto with normalize)
| |- context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) by (auto with normalize)
| |- _ => progress  (autorewrite with normalize); auto with typeclass_instances
| |- _ = ?x -> _ => intro; subst x
| |- ?x = _ -> _ => intro; subst x
|  |- ?ZZ -> _ => match type of ZZ with
| Prop =>
let H := fresh in
((assert (H:ZZ) by auto; clear H; intros _) || intro H)
| _ => intros _
end
| |- forall _, _ => let x := fresh "x" in (intro x; normalize1; try generalize dependent x)
| |- exp _ |-- _ => apply imp_extract_exp_left
| |- !! _ && _ |-- _ => apply derives_extract_prop
| |- _ && !! _ |-- _ => apply derives_extract_prop'
| |- _ |-- !! (?x = ?y) && _ =>
(rewrite prop_true_andp with (P:= (x=y))
by (unfold y; reflexivity); unfold y in *; clear y) ||
(rewrite prop_true_andp with (P:=(x=y))
by (unfold x; reflexivity); unfold x in *; clear x)
| |- _ => solve [auto with typeclass_instances]
end.
Ltac normalize1_in Hx :=
match type of Hx with
| app_pred (exp _) _ => destruct Hx
| app_pred (!! _ && _) _ => let H1 := fresh in destruct Hx as [H1 Hx]; unfold prop in H1
| context [ !! ?P ] =>
rewrite (true_eq P) in Hx by auto with typeclass_instances
| context [ !! ?P && ?Q ] =>
rewrite (prop_true_andp P Q) in Hx by auto with typeclass_instances
| context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) in Hx by (auto with normalize)
| context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) in Hx by (auto with normalize)
| context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) in Hx by (auto with normalize)
| context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) in Hx by (auto with normalize)
| _ => progress  (autorewrite with normalize in Hx); auto with typeclass_instances
end.
Ltac normalize := repeat normalize1.
Tactic Notation "normalize" "in" hyp(H) := repeat (normalize1_in H).
Definition mark {A: Type} (i: nat) (j: A) := j.

Lemma swap_mark0 {A} {JA: Join A}{PA: Perm_alg A}{agA: ageable A}{AgeA: Age_alg A}:
forall i j Pi Pj,  (i<j)%nat -> mark i Pi * mark j Pj = mark j Pj * mark i Pi.