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.
Ltac select_left n :=
repeat match goal with
| |- context [(_ * mark ?i _ * mark n _)%pred] =>
rewrite (swap_mark1 i n); [ | solve [simpl; auto]]
| |- context [(mark ?i _ * mark n _)%pred] =>
rewrite (swap_mark0 i n); [ | solve [simpl; auto]]
end.
Ltac select_all n := match n with
| O => idtac
| S ?n' => select_left n; select_all n'
end.
Ltac markem n P :=
match P with
| (?Y * ?Z) =>
(match goal with H: mark _ Z = Z |- _ => idtac end
|| assert (mark n Z = Z) by auto); markem (S n) Y
| ?Z =>  match goal with H: mark _ Z = Z |- _ => idtac end
|| assert (mark n Z = Z) by auto
end.
Ltac prove_assoc_commut :=
clear;
try (match goal with |- ?F _ -> ?G _ => replace G with F; auto end);
(repeat rewrite <- sepcon_assoc;
match goal with |- ?P = _ => markem O P end;
let LEFT := fresh "LEFT" in match goal with |- ?P = _ => set (LEFT := P) end;
match goal with H: mark ?n _ = _ |- _ =>
repeat  match goal with H: mark ?n _ = ?P |- _ => rewrite <- H; clear H end;
select_all n;
reflexivity
end).

Lemma test_prove_assoc_commut {T}{JA: Join T}{PA: Perm_alg T}{agA: ageable T}{AgeA: Age_alg T} : forall A B C D E : pred T,
D * E * A * C * B = A * B * C * D * E.