Ltac normalize1 :=
match goal with
| |- _ => contradiction
| |- context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
change (@andp A (@LiftNatDed T B C) D E F) with (D F && E F)
| |- context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
with (@later B C X5 (D F))
| |- context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
(@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
with (@sepcon C D H (J L) (K L))
| |- context [(?P && ?Q) * ?R] => rewrite (corable_andp_sepcon1 P Q R) by (auto with norm)
| |- context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) by (auto with norm)
| |- context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) by (auto with norm)
| |- context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) by (auto with norm)
(* In the next four rules, doing it this way (instead of leaving it to autorewrite) preserves the name of the "y" variable *)
| |- context [andp (exp (fun y => _)) _] =>
autorewrite with norm; apply imp_extract_exp_left; intro y
| |- context [andp _ (exp (fun y => _))] =>
autorewrite with norm; apply imp_extract_exp_left; intro y
| |- context [sepcon (exp (fun y => _)) _] =>
autorewrite with norm; apply imp_extract_exp_left; intro y
| |- context [sepcon _ (exp (fun y => _))] =>
autorewrite with norm; apply imp_extract_exp_left; intro y
| |-  derives ?A   _ => match A with
| context [ ((!! ?P) && ?Q) && ?R ] => rewrite (andp_assoc (!!P) Q R)
| context [ ?Q && (!! ?P && ?R)] =>
match Q with !! _ => fail 2 | _ => rewrite (andp_assoc' (!!P) Q R) end
end
| |- _ => progress  (autorewrite with norm); 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_prop0
| |- !! _ && _ |-- _ => 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)
| |- TT |-- !! _ => apply TT_prop_right
| |- _ => solve [auto with typeclass_instances]
end.
Ltac normalize1_in Hx :=
match type of Hx with
| context [@andp ?A (@LiftNatDed ?T ?B ?C) ?D ?E ?F] =>
change (@andp A (@LiftNatDed T B C) D E F) with (D F && E F)
| context [@later ?A  (@LiftNatDed ?T ?B ?C) (@LiftIndir ?X1 ?X2 ?X3 ?X4 ?X5) ?D ?F] =>
change (@later A  (@LiftNatDed T B C) (@LiftIndir X1 X2 X3 X4 X5) D F)
with (@later B C X5 (D F))
| context [@sepcon ?A (@LiftNatDed ?B ?C ?D)
(@LiftSepLog ?E ?F ?G ?H) ?J ?K ?L] =>
change (@sepcon A (@LiftNatDed B C D) (@LiftSepLog E F G H) J K L)
with (@sepcon C D H (J L) (K L))
| 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 norm)
| context [?Q * (?P && ?R)] => rewrite (corable_sepcon_andp1 P Q R) in Hx by (auto with norm)
| context [(?Q && ?P) * ?R] => rewrite (corable_andp_sepcon2 P Q R) in Hx by (auto with norm)
| context [?Q * (?R && ?P)] => rewrite (corable_sepcon_andp2 P Q R) in Hx by (auto with norm)
| _ => progress  (autorewrite with norm in Hx); auto with typeclass_instances
end.
Ltac normalize := repeat (auto with norm; normalize1).
Tactic Notation "normalize" "in" hyp(H) := repeat (normalize1_in H).

(* Specifications: *)
Lemma guarded_sepcon_orp_distr {A}{ND: NatDed A}{SL: SepLog A}: forall (P1 P2: Prop) p1 p2 q1 q2,
(P1 -> P2 -> False) ->
(!! P1 && p1 || !! P2 && p2) * (!! P1 && q1 || !! P2 && q2) = !! P1 && (p1 * q1) || !! P2 && (p2 * q2).